psblsa3-type-indexed:

base/internals/psi_dswapdata.F90

@@ -1527,6 +1527,7 @@ subroutine psi_dswapidx_vect_mptx(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,to
   use psb_desc_mod
   use psb_penv_mod
   use psb_d_base_vect_mod
+  use iso_c_binding
 #ifdef MPI_MOD
   use mpi
 #endif
@@ -1554,8 +1555,37 @@ subroutine psi_dswapidx_vect_mptx(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,to
   integer(psb_ipk_) :: ierr(5)
   logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
        & albf,do_send,do_recv
+
   logical, parameter :: usersend=.false.
 
+    interface 
+      function receive(v,recvtype,procSender,tag,communicator,handle) &
+           & result(res) bind(c,name='receiveRoutine')
+        use iso_c_binding   
+        !real(c_double)  :: v(*)
+        type(c_ptr), value	:: v
+        integer(c_int),value :: recvtype
+        integer(c_int),value :: communicator
+        integer(c_int),value :: procSender
+        integer(c_int),value :: tag
+        integer(c_int) :: handle
+        integer(c_int)  :: res
+      end function receive
+    end interface
+    interface 
+      function send(v,sendtype,procToSend,tag,communicator) &
+           & result(res) bind(c,name='sendRoutine')
+        use iso_c_binding   
+        !real(c_double)  :: v(*)
+        type(c_ptr), value	:: v
+        integer(c_int),value :: sendtype
+        integer(c_int),value :: communicator
+        integer(c_int),value :: procToSend
+        integer(c_int),value :: tag
+        integer(c_int)  :: res
+      end function send
+    end interface
+
   real(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
 #ifdef HAVE_VOLATILE
   volatile :: sndbuf, rcvbuf
@@ -1659,19 +1689,17 @@ subroutine psi_dswapidx_vect_mptx(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,to
 
     ! First I post all the non blocking receives
     pnti   = 1
-    snd_pt = 1
-    rcv_pt = 1
     do i=1, totxch
       nerv = idx(pnti+psb_n_elem_recv_)
       nesd = idx(pnti+nerv+psb_n_elem_send_)
 
       if (nerv>0) then 
         p2ptag = psb_double_swap_tag
-        call receive_routine(y%v,recvtypes(i),prcid(i),&
-             & p2ptag,icomm,rvhd(i),iret)
+!!$        call receive_routine(y%v,recvtypes(i),prcid(i),&
+!!$             & p2ptag,icomm,rvhd(i),iret)
+        iret = receive(y%get_clocv(),recvtypes(i),prcid(i),&
+             & p2ptag,icomm,rvhd(i))
       end if
-      rcv_pt = rcv_pt + nerv
-      snd_pt = snd_pt + nesd
       pnti   = pnti + nerv + nesd + 3
     end do
 
@@ -1680,15 +1708,15 @@ subroutine psi_dswapidx_vect_mptx(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,to
     if (usersend)  call mpi_barrier(icomm,iret)
 
     pnti   = 1
-    snd_pt = 1
-    rcv_pt = 1
     do i=1, totxch
       nerv = idx(pnti+psb_n_elem_recv_)
       nesd = idx(pnti+nerv+psb_n_elem_send_)
 
       p2ptag = psb_double_swap_tag
       if (nesd>0) then
-        call send_routine(y%v,sendtypes(i),prcid(i),p2ptag,icomm, iret)
+!!$        call send_routine(y%v,sendtypes(i),prcid(i),p2ptag,icomm, iret)
+        iret = send(y%get_clocv(),sendtypes(i),prcid(i),&
+             & p2ptag,icomm)
         if(iret /= mpi_success) then
           ierr(1) = iret
           info=psb_err_mpi_error_
@@ -1696,8 +1724,6 @@ subroutine psi_dswapidx_vect_mptx(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,to
           goto 9999
         end if
       end if
-      rcv_pt = rcv_pt + nerv
-      snd_pt = snd_pt + nesd
       pnti   = pnti + nerv + nesd + 3
     end do
 

base/modules/psb_d_base_vect_mod.f90

@@ -137,11 +137,12 @@ module psb_d_base_vect_mod
     ! Gather/scatter. These are needed for MPI interfacing.
     ! May have to be reworked. 
     !
-    procedure, pass(x) :: gthab    => d_base_gthab
-    procedure, pass(x) :: gthzv    => d_base_gthzv
-    generic, public    :: gth      => gthab, gthzv
-    procedure, pass(y) :: sctb     => d_base_sctb
-    generic, public    :: sct      => sctb
+    procedure, pass(x) :: gthab     => d_base_gthab
+    procedure, pass(x) :: gthzv     => d_base_gthzv
+    generic, public    :: gth       => gthab, gthzv
+    procedure, pass(y) :: sctb      => d_base_sctb
+    generic, public    :: sct       => sctb
+    procedure, pass(x) :: get_clocv => d_base_get_clocv
   end type psb_d_base_vect_type
 
   public  :: psb_d_base_vect
@@ -817,4 +818,23 @@ contains
 
   end subroutine d_base_sctb
 
+  function d_base_get_clocv(x) result(res)
+    use iso_c_binding
+
+    class(psb_d_base_vect_type), target :: x
+    type(c_ptr)                         :: res
+    if (allocated(x%v)) then 
+      call aux_get_clocv(x%v,res)
+!!$      res = c_loc(x%v)
+    else
+      res = c_null_ptr
+    end if
+  end function d_base_get_clocv
+  subroutine  aux_get_clocv(v,res)
+    use iso_c_binding
+    real(psb_dpk_), target :: v(*)    
+    type(c_ptr)            :: res
+    res = c_loc(v)
+  end subroutine aux_get_clocv
+
 end module psb_d_base_vect_mod

configure.ac

@@ -561,7 +561,7 @@ PAC_FORTRAN_HAVE_MOVE_ALLOC(
 )
 
 PAC_FORTRAN_TEST_ISO_C_BIND( 
-	[FDEFINES="$psblas_cv_define_prepend-DHAVE_ISO_C_BINDING $FDEFINES"],
+	[],
         [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for ISO_C_BINDING. 
  Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.6.])]
 )

util/psb_c_renum_impl.F90

@@ -215,9 +215,7 @@ contains
 
 
   subroutine psb_mat_renum_amd(a,info,operm)
-#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
     use iso_c_binding
-#endif
     use psb_base_mod    
     implicit none 
     type(psb_cspmat_type), intent(inout) :: a
@@ -225,7 +223,7 @@ contains
     integer(psb_ipk_), allocatable, optional, intent(out) :: operm(:)
 
     ! 
-#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
+#if defined(HAVE_AMD)
     interface 
       function psb_amd_order(n,ap,ai,p)&
            & result(res) bind(c,name='psb_amd_order')
@@ -250,7 +248,7 @@ contains
     name = 'mat_renum_amd'
     call psb_erractionsave(err_act)
 
-#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
+#if defined(HAVE_AMD)
 
     info = psb_success_
     nr   = a%get_nrows()

util/psb_d_renum_impl.F90

@@ -215,9 +215,7 @@ contains
 
 
   subroutine psb_mat_renum_amd(a,info,operm)
-#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
     use iso_c_binding
-#endif
     use psb_base_mod    
     implicit none 
     type(psb_dspmat_type), intent(inout) :: a
@@ -225,7 +223,7 @@ contains
     integer(psb_ipk_), allocatable, optional, intent(out) :: operm(:)
 
     ! 
-#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
+#if defined(HAVE_AMD) 
     interface 
       function psb_amd_order(n,ap,ai,p)&
            & result(res) bind(c,name='psb_amd_order')
@@ -250,7 +248,7 @@ contains
     name = 'mat_renum_amd'
     call psb_erractionsave(err_act)
 
-#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
+#if defined(HAVE_AMD) 
 
     info = psb_success_
     nr   = a%get_nrows()

util/psb_s_renum_impl.F90

@@ -215,9 +215,7 @@ contains
 
 
   subroutine psb_mat_renum_amd(a,info,operm)
-#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
     use iso_c_binding
-#endif
     use psb_base_mod    
     implicit none 
     type(psb_sspmat_type), intent(inout) :: a
@@ -225,7 +223,7 @@ contains
     integer(psb_ipk_), allocatable, optional, intent(out) :: operm(:)
 
     ! 
-#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
+#if defined(HAVE_AMD)
     interface 
       function psb_amd_order(n,ap,ai,p)&
            & result(res) bind(c,name='psb_amd_order')
@@ -250,7 +248,7 @@ contains
     name = 'mat_renum_amd'
     call psb_erractionsave(err_act)
 
-#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
+#if defined(HAVE_AMD)
 
     info = psb_success_
     nr   = a%get_nrows()

util/psb_z_renum_impl.F90

@@ -215,9 +215,7 @@ contains
 
 
   subroutine psb_mat_renum_amd(a,info,operm)
-#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
     use iso_c_binding
-#endif
     use psb_base_mod    
     implicit none 
     type(psb_zspmat_type), intent(inout) :: a
@@ -225,7 +223,7 @@ contains
     integer(psb_ipk_), allocatable, optional, intent(out) :: operm(:)
 
     ! 
-#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
+#if defined(HAVE_AMD)
     interface 
       function psb_amd_order(n,ap,ai,p)&
            & result(res) bind(c,name='psb_amd_order')
@@ -250,7 +248,7 @@ contains
     name = 'mat_renum_amd'
     call psb_erractionsave(err_act)
 
-#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
+#if defined(HAVE_AMD)
 
     info = psb_success_
     nr   = a%get_nrows()