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

@@ -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

base/modules/tools/psb_d_tools_mod.F90

@@ -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

base/modules/tools/psb_s_tools_mod.F90

@@ -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

base/modules/tools/psb_z_tools_mod.F90

@@ -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

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
+