psblas3-type-indexed:

base/internals/psi_dswapdata.F90
 base/modules/psb_d_base_vect_mod.f90
 base/modules/psb_s_base_vect_mod.f90

Safegurds to choose whether to use TYPE_INDEXED.

base/internals/psi_dswapdata.F90

@@ -1613,7 +1613,8 @@ subroutine psi_dswapidx_vect_mptx(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,to
   do_send = swap_mpi .or. swap_sync .or. swap_send
   do_recv = swap_mpi .or. swap_sync .or. swap_recv
 
-  if (beta==dzero .and. do_send .and. do_recv .and.sendtypes(1)/=mpi_datatype_null) then
+  if (y%type_idx() .and. beta==dzero .and. do_send .and. do_recv .and. &
+       & sendtypes(1)/=mpi_datatype_null) then
 
     allocate(rvhd(totxch),prcid(totxch),stat=info) 
     if(info /= psb_success_) then
@@ -1631,58 +1632,6 @@ subroutine psi_dswapidx_vect_mptx(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,to
       bfsz = max(bfsz,nesd,nerv)
       pnti   = pnti + nerv + nesd + 3      
     end do
-!!$    allocate(blens(bfsz),new_idx(bfsz),stat=info)
-!!$    if(info /= psb_success_) then
-!!$      call psb_errpush(psb_err_alloc_dealloc_,name)
-!!$      goto 9999
-!!$    end if
-!!$
-!!$
-!!$    !We've to set the derivate datatypes
-!!$    !Send/Gather
-!!$    pnti   = 1
-!!$    snd_pt = 1
-!!$    if (sendtypes(1)==mpi_datatype_null) then
-!!$      do i=1, totxch
-!!$        nerv = idx(pnti+psb_n_elem_recv_)
-!!$        nesd = idx(pnti+nerv+psb_n_elem_send_)
-!!$        idx_pt = 1+pnti+nerv+psb_n_elem_send_
-!!$        do j=1,nesd
-!!$          blens(j)   = 1
-!!$          new_idx(i) = idx(idx_pt+i-1)-1
-!!$        end do
-!!$        call MPI_TYPE_INDEXED(nesd,blens,new_idx,&
-!!$    	     & psb_mpi_r_dpk_,sendtypes(i),iret)
-!!$        call MPI_TYPE_COMMIT(sendtypes(i),iret)
-!!$        snd_pt = snd_pt + nesd 
-!!$    	pnti   = pnti + nerv + nesd + 3
-!!$      end do
-!!$    end if
-!!$
-!!$    !Recv/Scatter
-!!$    pnti   = 1
-!!$    snd_pt = 1
-!!$    rcv_pt = 1
-!!$    if (recvtypes(1)==mpi_datatype_null) then
-!!$      do i=1, totxch
-!!$        proc_to_comm = idx(pnti+psb_proc_id_)
-!!$        nerv = idx(pnti+psb_n_elem_recv_)
-!!$        nesd = idx(pnti+nerv+psb_n_elem_send_)
-!!$        idx_pt = 1+pnti+psb_n_elem_recv_
-!!$        do j=1, nerv
-!!$          blens(j)   = 1
-!!$          new_idx(i) = idx(idx_pt+i-1)-1
-!!$        end do
-!!$        call mpi_type_indexed(nerv,blens,new_idx,&
-!!$             & psb_mpi_r_dpk_,recvtypes(i),iret)
-!!$        call mpi_type_commit(recvtypes(i),iret)
-!!$
-!!$        rcv_pt = rcv_pt + nerv
-!!$        snd_pt = snd_pt + nesd
-!!$        pnti   = pnti + nerv + nesd + 3
-!!$      end do
-!!$    end if
-!!$
 
 
     !write(*,*) 'Sono dentro swap_send .and. swap_recv'

base/modules/psb_d_base_vect_mod.f90

@@ -142,6 +142,7 @@ module psb_d_base_vect_mod
     generic, public    :: gth       => gthab, gthzv
     procedure, pass(y) :: sctb      => d_base_sctb
     generic, public    :: sct       => sctb
+    procedure, pass(x) :: type_idx  => d_base_type_idx
     procedure, pass(x) :: get_clocv => d_base_get_clocv
   end type psb_d_base_vect_type
 
@@ -818,6 +819,19 @@ contains
 
   end subroutine d_base_sctb
 
+  !
+  ! Whether we should go for data exchange
+  ! using MPI_TYPE_INDEXED, if at all
+  ! possible.
+  !
+  function d_base_type_idx(x) result(res)
+    class(psb_d_base_vect_type) :: x
+    logical                     :: res
+
+    res = .true.
+
+  end function d_base_type_idx
+
   function d_base_get_clocv(x) result(res)
     use iso_c_binding
 
@@ -825,17 +839,17 @@ contains
     type(c_ptr)                         :: res
 
     if (allocated(x%v)) then 
-      call aux_get_clocv(x%v,res)
-!!$      res = c_loc(x%v)
+      call d_aux_get_clocv(x%v,res)
     else
       res = c_null_ptr
     end if
   end function d_base_get_clocv
-  subroutine  aux_get_clocv(v,res)
+
+  subroutine  d_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 subroutine d_aux_get_clocv
 
 end module psb_d_base_vect_mod

base/modules/psb_s_base_vect_mod.f90

@@ -142,6 +142,8 @@ module psb_s_base_vect_mod
     generic, public    :: gth      => gthab, gthzv
     procedure, pass(y) :: sctb     => s_base_sctb
     generic, public    :: sct      => sctb
+    procedure, pass(x) :: type_idx  => s_base_type_idx
+    procedure, pass(x) :: get_clocv => s_base_get_clocv
   end type psb_s_base_vect_type
 
   public  :: psb_s_base_vect
@@ -817,4 +819,38 @@ contains
 
   end subroutine s_base_sctb
 
+
+  !
+  ! Whether we should go for data exchange
+  ! using MPI_TYPE_INDEXED, if at all
+  ! possible.
+  !
+  function s_base_type_idx(x) result(res)
+    class(psb_s_base_vect_type) :: x
+    logical                     :: res
+
+    res = .true.
+
+  end function s_base_type_idx
+
+  function s_base_get_clocv(x) result(res)
+    use iso_c_binding
+
+    class(psb_s_base_vect_type), target :: x
+    type(c_ptr)                         :: res
+
+    if (allocated(x%v)) then 
+      call s_aux_get_clocv(x%v,res)
+    else
+      res = c_null_ptr
+    end if
+  end function s_base_get_clocv
+
+  subroutine  s_aux_get_clocv(v,res)
+    use iso_c_binding
+    real(psb_spk_), target :: v(*)    
+    type(c_ptr)            :: res
+    res = c_loc(v)
+  end subroutine s_aux_get_clocv
+
 end module psb_s_base_vect_mod