Added getelem_vec implementation

base/modules/auxil/psb_c_realloc_mod.F90

@@ -1017,7 +1017,7 @@ Contains
         if (present(newsz)) then
           isz = max(len+1,1,newsz)
         else if (present(addsz)) then
-          isz = max(len,1,isz+addsz)
+          isz = max(len,1,isz+addsz))
         else
           isz = max(len,1,int(1.25*isz))
         endif

base/modules/auxil/psb_d_realloc_mod.F90

@@ -1017,7 +1017,7 @@ Contains
         if (present(newsz)) then
           isz = max(len+1,1,newsz)
         else if (present(addsz)) then
-          isz = max(len,1,isz+addsz)
+          isz = max(len,1,isz+addsz))
         else
           isz = max(len,1,int(1.25*isz))
         endif

base/modules/auxil/psb_e_realloc_mod.F90

@@ -1017,7 +1017,7 @@ Contains
         if (present(newsz)) then
           isz = max(len+1,1,newsz)
         else if (present(addsz)) then
-          isz = max(len,1,isz+addsz)
+          isz = max(len,1,isz+addsz))
         else
           isz = max(len,1,int(1.25*isz))
         endif

base/modules/auxil/psb_i2_realloc_mod.F90

@@ -1017,7 +1017,7 @@ Contains
         if (present(newsz)) then
           isz = max(len+1,1,newsz)
         else if (present(addsz)) then
-          isz = max(len,1,isz+addsz)
+          isz = max(len,1,isz+addsz))
         else
           isz = max(len,1,int(1.25*isz))
         endif

base/modules/auxil/psb_m_realloc_mod.F90

@@ -1017,7 +1017,7 @@ Contains
         if (present(newsz)) then
           isz = max(len+1,1,newsz)
         else if (present(addsz)) then
-          isz = max(len,1,isz+addsz)
+          isz = max(len,1,isz+addsz))
         else
           isz = max(len,1,int(1.25*isz))
         endif

base/modules/auxil/psb_s_realloc_mod.F90

@@ -1017,7 +1017,7 @@ Contains
         if (present(newsz)) then
           isz = max(len+1,1,newsz)
         else if (present(addsz)) then
-          isz = max(len,1,isz+addsz)
+          isz = max(len,1,isz+addsz))
         else
           isz = max(len,1,int(1.25*isz))
         endif

base/modules/auxil/psb_z_realloc_mod.F90

@@ -1017,7 +1017,7 @@ Contains
         if (present(newsz)) then
           isz = max(len+1,1,newsz)
         else if (present(addsz)) then
-          isz = max(len,1,isz+addsz)
+          isz = max(len,1,isz+addsz))
         else
           isz = max(len,1,int(1.25*isz))
         endif

base/modules/tools/psb_c_tools_mod.F90

@@ -171,7 +171,7 @@ Module psb_c_tools_mod
       logical, intent(in), optional        :: local
     end subroutine psb_cins_multivect
   end interface
-  
+
   interface psb_cdbldext
     Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info,extype)
       import
@@ -272,7 +272,7 @@ Module psb_c_tools_mod
       integer(psb_ipk_), intent(out)            :: info
     end subroutine psb_lc_remote_mat
   end interface psb_remote_mat
-  
+
   interface psb_spfree
     subroutine psb_cspfree(a, desc_a,info)
       import
@@ -440,6 +440,14 @@ Module psb_c_tools_mod
       integer(psb_ipk_), intent(out)         :: info
       complex(psb_spk_)                        :: res
     end function
+    function psb_c_getelem_vec(x,index,desc_a,info) result(res)
+      import
+      type(psb_c_vect_type), intent(inout) :: x
+      integer(psb_lpk_), intent(in), dimension(:) :: index
+      type(psb_desc_type), intent(inout)     :: desc_a
+      integer(psb_ipk_), intent(out)         :: info
+      complex(psb_spk_), allocatable, dimension(:) :: res
+    end function
   end interface
 
   interface psb_remap
@@ -453,7 +461,7 @@ Module psb_c_tools_mod
       type(psb_cspmat_type), intent(inout) :: a_in
       type(psb_cspmat_type), intent(out)   :: a_out
       type(psb_desc_type), intent(out)     :: desc_out
-      integer(psb_ipk_), intent(out)       :: ipd 
+      integer(psb_ipk_), intent(out)       :: ipd
       integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:), naggr(:)
       integer(psb_ipk_), intent(out)       :: info
     end subroutine psb_c_remap

base/modules/tools/psb_d_tools_mod.F90

@@ -171,7 +171,7 @@ Module psb_d_tools_mod
       logical, intent(in), optional        :: local
     end subroutine psb_dins_multivect
   end interface
-  
+
   interface psb_cdbldext
     Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info,extype)
       import
@@ -272,7 +272,7 @@ Module psb_d_tools_mod
       integer(psb_ipk_), intent(out)            :: info
     end subroutine psb_ld_remote_mat
   end interface psb_remote_mat
-  
+
   interface psb_spfree
     subroutine psb_dspfree(a, desc_a,info)
       import
@@ -440,6 +440,14 @@ Module psb_d_tools_mod
       integer(psb_ipk_), intent(out)         :: info
       real(psb_dpk_)                        :: res
     end function
+    function psb_d_getelem_vec(x,index,desc_a,info) result(res)
+      import
+      type(psb_d_vect_type), intent(inout) :: x
+      integer(psb_lpk_), intent(in), dimension(:) :: index
+      type(psb_desc_type), intent(inout)     :: desc_a
+      integer(psb_ipk_), intent(out)         :: info
+      real(psb_dpk_), allocatable, dimension(:) :: res
+    end function
   end interface
 
   interface psb_remap
@@ -453,7 +461,7 @@ Module psb_d_tools_mod
       type(psb_dspmat_type), intent(inout) :: a_in
       type(psb_dspmat_type), intent(out)   :: a_out
       type(psb_desc_type), intent(out)     :: desc_out
-      integer(psb_ipk_), intent(out)       :: ipd 
+      integer(psb_ipk_), intent(out)       :: ipd
       integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:), naggr(:)
       integer(psb_ipk_), intent(out)       :: info
     end subroutine psb_d_remap

base/modules/tools/psb_i_tools_mod.F90

@@ -170,5 +170,5 @@ Module psb_i_tools_mod
       logical, intent(in), optional        :: local
     end subroutine psb_iins_multivect
   end interface
-  
+
 end module psb_i_tools_mod

base/modules/tools/psb_l_tools_mod.F90

@@ -170,5 +170,5 @@ Module psb_l_tools_mod
       logical, intent(in), optional        :: local
     end subroutine psb_lins_multivect
   end interface
-  
+
 end module psb_l_tools_mod

base/modules/tools/psb_s_tools_mod.F90

@@ -171,7 +171,7 @@ Module psb_s_tools_mod
       logical, intent(in), optional        :: local
     end subroutine psb_sins_multivect
   end interface
-  
+
   interface psb_cdbldext
     Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info,extype)
       import
@@ -272,7 +272,7 @@ Module psb_s_tools_mod
       integer(psb_ipk_), intent(out)            :: info
     end subroutine psb_ls_remote_mat
   end interface psb_remote_mat
-  
+
   interface psb_spfree
     subroutine psb_sspfree(a, desc_a,info)
       import
@@ -440,6 +440,14 @@ Module psb_s_tools_mod
       integer(psb_ipk_), intent(out)         :: info
       real(psb_spk_)                        :: res
     end function
+    function psb_s_getelem_vec(x,index,desc_a,info) result(res)
+      import
+      type(psb_s_vect_type), intent(inout) :: x
+      integer(psb_lpk_), intent(in), dimension(:) :: index
+      type(psb_desc_type), intent(inout)     :: desc_a
+      integer(psb_ipk_), intent(out)         :: info
+      real(psb_spk_), allocatable, dimension(:) :: res
+    end function
   end interface
 
   interface psb_remap
@@ -453,7 +461,7 @@ Module psb_s_tools_mod
       type(psb_sspmat_type), intent(inout) :: a_in
       type(psb_sspmat_type), intent(out)   :: a_out
       type(psb_desc_type), intent(out)     :: desc_out
-      integer(psb_ipk_), intent(out)       :: ipd 
+      integer(psb_ipk_), intent(out)       :: ipd
       integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:), naggr(:)
       integer(psb_ipk_), intent(out)       :: info
     end subroutine psb_s_remap

base/modules/tools/psb_z_tools_mod.F90

@@ -171,7 +171,7 @@ Module psb_z_tools_mod
       logical, intent(in), optional        :: local
     end subroutine psb_zins_multivect
   end interface
-  
+
   interface psb_cdbldext
     Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info,extype)
       import
@@ -272,7 +272,7 @@ Module psb_z_tools_mod
       integer(psb_ipk_), intent(out)            :: info
     end subroutine psb_lz_remote_mat
   end interface psb_remote_mat
-  
+
   interface psb_spfree
     subroutine psb_zspfree(a, desc_a,info)
       import
@@ -440,6 +440,14 @@ Module psb_z_tools_mod
       integer(psb_ipk_), intent(out)         :: info
       complex(psb_dpk_)                        :: res
     end function
+    function psb_z_getelem_vec(x,index,desc_a,info) result(res)
+      import
+      type(psb_z_vect_type), intent(inout) :: x
+      integer(psb_lpk_), intent(in), dimension(:) :: index
+      type(psb_desc_type), intent(inout)     :: desc_a
+      integer(psb_ipk_), intent(out)         :: info
+      complex(psb_dpk_), allocatable, dimension(:) :: res
+    end function
   end interface
 
   interface psb_remap
@@ -453,7 +461,7 @@ Module psb_z_tools_mod
       type(psb_zspmat_type), intent(inout) :: a_in
       type(psb_zspmat_type), intent(out)   :: a_out
       type(psb_desc_type), intent(out)     :: desc_out
-      integer(psb_ipk_), intent(out)       :: ipd 
+      integer(psb_ipk_), intent(out)       :: ipd
       integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:), naggr(:)
       integer(psb_ipk_), intent(out)       :: info
     end subroutine psb_z_remap

base/tools/psb_cgetelem.f90

@@ -108,3 +108,69 @@ function psb_c_getelem(x,index,desc_a,info) result(res)
 
 end function
 
+function psb_c_getelem_vec(x,index,desc_a,info) result(res)
+  use psb_base_mod, psb_protect_name => psb_c_getelem_vec
+  use psi_mod
+  implicit none
+
+  type(psb_c_vect_type), intent(inout) :: x
+  integer(psb_lpk_), intent(in), dimension(:) :: index
+  type(psb_desc_type), intent(inout)     :: desc_a
+  integer(psb_ipk_), intent(out)         :: info
+  complex(psb_spk_), allocatable, dimension(:) :: res
+  ! Local Variables
+  integer(psb_ipk_) :: nindex, i
+  integer(psb_ipk_) :: np, me, err_act
+  integer(psb_ipk_), allocatable, dimension(:) :: localindex
+  integer(psb_lpk_) :: gindex(1)
+  type(psb_ctxt_type) :: ctxt
+  character(len=20) :: name
+
+  if (psb_errstatus_fatal()) return
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  name = 'psb_c_getelem_vec'
+
+  nindex = size(index)
+
+  if (.not.allocated(res)) then
+    allocate(res(nindex),stat=info)
+  end if
+  res = czero
+
+  if (.not.desc_a%is_ok()) then
+    info = psb_err_invalid_cd_state_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  ctxt = desc_a%get_context()
+
+  call psb_info(ctxt, me, np)
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  do i = 1,nindex
+    gindex(1) = index(i)
+    call desc_a%indxmap%g2l(gindex,localindex,info,owned=.true.)
+    if ( localindex(1) > 1) then
+        res(i) = x%get_entry(localindex(1))
+    end if
+  end do
+
+  call psb_sum(ctxt,res,root=-1)
+
+
+  ! Error handling and closing
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end function
+

base/tools/psb_dgetelem.f90

@@ -108,3 +108,69 @@ function psb_d_getelem(x,index,desc_a,info) result(res)
 
 end function
 
+function psb_d_getelem_vec(x,index,desc_a,info) result(res)
+  use psb_base_mod, psb_protect_name => psb_d_getelem_vec
+  use psi_mod
+  implicit none
+
+  type(psb_d_vect_type), intent(inout) :: x
+  integer(psb_lpk_), intent(in), dimension(:) :: index
+  type(psb_desc_type), intent(inout)     :: desc_a
+  integer(psb_ipk_), intent(out)         :: info
+  real(psb_dpk_), allocatable, dimension(:) :: res
+  ! Local Variables
+  integer(psb_ipk_) :: nindex, i
+  integer(psb_ipk_) :: np, me, err_act
+  integer(psb_ipk_), allocatable, dimension(:) :: localindex
+  integer(psb_lpk_) :: gindex(1)
+  type(psb_ctxt_type) :: ctxt
+  character(len=20) :: name
+
+  if (psb_errstatus_fatal()) return
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  name = 'psb_d_getelem_vec'
+
+  nindex = size(index)
+
+  if (.not.allocated(res)) then
+    allocate(res(nindex),stat=info)
+  end if
+  res = dzero
+
+  if (.not.desc_a%is_ok()) then
+    info = psb_err_invalid_cd_state_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  ctxt = desc_a%get_context()
+
+  call psb_info(ctxt, me, np)
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  do i = 1,nindex
+    gindex(1) = index(i)
+    call desc_a%indxmap%g2l(gindex,localindex,info,owned=.true.)
+    if ( localindex(1) > 1) then
+        res(i) = x%get_entry(localindex(1))
+    end if
+  end do
+
+  call psb_sum(ctxt,res,root=-1)
+
+
+  ! Error handling and closing
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end function
+

base/tools/psb_sgetelem.f90

@@ -108,3 +108,69 @@ function psb_s_getelem(x,index,desc_a,info) result(res)
 
 end function
 
+function psb_s_getelem_vec(x,index,desc_a,info) result(res)
+  use psb_base_mod, psb_protect_name => psb_s_getelem_vec
+  use psi_mod
+  implicit none
+
+  type(psb_s_vect_type), intent(inout) :: x
+  integer(psb_lpk_), intent(in), dimension(:) :: index
+  type(psb_desc_type), intent(inout)     :: desc_a
+  integer(psb_ipk_), intent(out)         :: info
+  real(psb_spk_), allocatable, dimension(:) :: res
+  ! Local Variables
+  integer(psb_ipk_) :: nindex, i
+  integer(psb_ipk_) :: np, me, err_act
+  integer(psb_ipk_), allocatable, dimension(:) :: localindex
+  integer(psb_lpk_) :: gindex(1)
+  type(psb_ctxt_type) :: ctxt
+  character(len=20) :: name
+
+  if (psb_errstatus_fatal()) return
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  name = 'psb_s_getelem_vec'
+
+  nindex = size(index)
+
+  if (.not.allocated(res)) then
+    allocate(res(nindex),stat=info)
+  end if
+  res = szero
+
+  if (.not.desc_a%is_ok()) then
+    info = psb_err_invalid_cd_state_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  ctxt = desc_a%get_context()
+
+  call psb_info(ctxt, me, np)
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  do i = 1,nindex
+    gindex(1) = index(i)
+    call desc_a%indxmap%g2l(gindex,localindex,info,owned=.true.)
+    if ( localindex(1) > 1) then
+        res(i) = x%get_entry(localindex(1))
+    end if
+  end do
+
+  call psb_sum(ctxt,res,root=-1)
+
+
+  ! Error handling and closing
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end function
+

base/tools/psb_zgetelem.f90

@@ -108,3 +108,69 @@ function psb_z_getelem(x,index,desc_a,info) result(res)
 
 end function
 
+function psb_z_getelem_vec(x,index,desc_a,info) result(res)
+  use psb_base_mod, psb_protect_name => psb_z_getelem_vec
+  use psi_mod
+  implicit none
+
+  type(psb_z_vect_type), intent(inout) :: x
+  integer(psb_lpk_), intent(in), dimension(:) :: index
+  type(psb_desc_type), intent(inout)     :: desc_a
+  integer(psb_ipk_), intent(out)         :: info
+  complex(psb_dpk_), allocatable, dimension(:) :: res
+  ! Local Variables
+  integer(psb_ipk_) :: nindex, i
+  integer(psb_ipk_) :: np, me, err_act
+  integer(psb_ipk_), allocatable, dimension(:) :: localindex
+  integer(psb_lpk_) :: gindex(1)
+  type(psb_ctxt_type) :: ctxt
+  character(len=20) :: name
+
+  if (psb_errstatus_fatal()) return
+  info=psb_success_
+  call psb_erractionsave(err_act)
+  name = 'psb_z_getelem_vec'
+
+  nindex = size(index)
+
+  if (.not.allocated(res)) then
+    allocate(res(nindex),stat=info)
+  end if
+  res = zzero
+
+  if (.not.desc_a%is_ok()) then
+    info = psb_err_invalid_cd_state_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  ctxt = desc_a%get_context()
+
+  call psb_info(ctxt, me, np)
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  do i = 1,nindex
+    gindex(1) = index(i)
+    call desc_a%indxmap%g2l(gindex,localindex,info,owned=.true.)
+    if ( localindex(1) > 1) then
+        res(i) = x%get_entry(localindex(1))
+    end if
+  end do
+
+  call psb_sum(ctxt,res,root=-1)
+
+
+  ! Error handling and closing
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(ctxt,err_act)
+
+  return
+
+end function
+