Merge pull request #29 from fdrmrc/local_idx

Expose psb_cdall() routine that takes local indices to C interface

cbind/base/psb_base_tools_cbind_mod.F90

@@ -141,6 +141,48 @@ contains
 
   end function psb_c_cdall_vl_opt
 
+  function psb_c_cdall_vl_lidx(nl,vl,lidx,cctxt,cdh) bind(c,name='psb_c_cdall_vl_lidx') result(res)
+    implicit none
+
+    integer(psb_c_ipk_) :: res
+    type(psb_c_object_type), value :: cctxt
+    integer(psb_c_ipk_), value :: nl
+    integer(psb_c_lpk_)        :: vl(*)
+    integer(psb_c_lpk_)        :: lidx(*)
+    type(psb_c_object_type) :: cdh
+    type(psb_desc_type), pointer :: descp
+    integer(psb_c_ipk_)           :: info, ixb
+    type(psb_ctxt_type) :: ctxt
+    ctxt = psb_c2f_ctxt(cctxt)
+
+    res = -1
+    if (nl <=0) then
+      write(0,*) 'Invalid size'
+      return
+    end if
+
+    if (c_associated(cdh%item)) then
+      call c_f_pointer(cdh%item,descp)
+      call descp%free(info)
+      if (info == 0) deallocate(descp,stat=info)
+      if (info /= 0) return
+    end if
+
+    allocate(descp,stat=info)
+    if (info < 0) return
+
+    ixb = psb_c_get_index_base()
+
+    if (ixb == 1) then
+      call psb_cdall(ctxt,descp,info,vl=vl(1:nl),lidx=int(lidx(1:nl),psb_ipk_))
+    else
+      call psb_cdall(ctxt,descp,info,vl=(vl(1:nl)+(1-ixb)),lidx=int(lidx(1:nl)+(1-ixb),psb_ipk_))
+    end if
+    cdh%item = c_loc(descp)
+    res = info
+
+  end function psb_c_cdall_vl_lidx
+
   function psb_c_cdall_nl(nl,cctxt,cdh) bind(c,name='psb_c_cdall_nl') result(res)
     implicit none
 

cbind/base/psb_c_base.h

@@ -75,6 +75,7 @@ extern "C" {
   void psb_c_delete_ctxt(psb_c_ctxt *);
   psb_i_t    psb_c_cdall_vg(psb_l_t ng, psb_i_t *vg, psb_c_ctxt cctxt, psb_c_descriptor *cd);
   psb_i_t    psb_c_cdall_vl(psb_i_t nl, psb_l_t *vl, psb_c_ctxt cctxt, psb_c_descriptor *cd);
+  psb_i_t    psb_c_cdall_vl_lidx(psb_i_t nl, psb_l_t *vl, psb_l_t *lidx,psb_c_ctxt cctxt, psb_c_descriptor *cd);
   psb_i_t    psb_c_cdall_nl(psb_i_t nl, psb_c_ctxt cctxt, psb_c_descriptor *cd);
   psb_i_t    psb_c_cdall_repl(psb_l_t n, psb_c_ctxt cctxt, psb_c_descriptor *cd);
   psb_i_t    psb_c_cdasb(psb_c_descriptor *cd);