mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-17 19:32:08 +00:00
psblas3:
base/internals/psi_bld_tmphalo.f90 base/internals/psi_idx_cnv.f90 base/internals/psi_idx_ins_cnv.f90 base/modules/psb_c_base_vect_mod.f90 base/modules/psb_c_vect_mod.F90 base/modules/psb_d_base_vect_mod.f90 base/modules/psb_d_linmap_mod.f90 base/modules/psb_d_vect_mod.F90 base/modules/psb_i_base_vect_mod.f90 base/modules/psb_i_vect_mod.F90 base/modules/psb_s_base_vect_mod.f90 base/modules/psb_s_vect_mod.F90 base/modules/psb_z_base_vect_mod.f90 base/modules/psb_z_vect_mod.F90 base/tools/psb_cd_switch_ovl_indxmap.f90 base/tools/psb_loc_to_glob.f90 Fixes for G2L/L2G with IP versions. Fixes for MOLD on vectors. New sed scripts.
This commit is contained in:
Salvatore Filippone
@@ -100,7 +100,7 @@ subroutine psi_bld_tmphalo(desc,info)
|
||||
helem(i) = n_row+i ! desc%loc_to_glob(n_row+i)
|
||||
end do
|
||||
|
||||
call desc%indxmap%l2g(helem(1:nh),info)
|
||||
call desc%indxmap%l2gip(helem(1:nh),info)
|
||||
call desc%indxmap%fnd_owner(helem(1:nh),hproc,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
|
||||
@@ -112,7 +112,7 @@ subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned)
|
||||
end if
|
||||
endif
|
||||
|
||||
call desc%indxmap%g2l(idxin(1:nv),info,mask=mask,owned=owned)
|
||||
call desc%indxmap%g2lip(idxin(1:nv),info,mask=mask,owned=owned)
|
||||
|
||||
if (info /= 0) then
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err='g2l')
|
||||
|
||||
@@ -113,7 +113,7 @@ subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask,lidx)
|
||||
endif
|
||||
|
||||
|
||||
call desc%indxmap%g2l_ins(idxin(1:nv),info,mask=mask,lidx=lidx)
|
||||
call desc%indxmap%g2lip_ins(idxin(1:nv),info,mask=mask,lidx=lidx)
|
||||
|
||||
if (info /= 0) then
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err='g2l_ins')
|
||||
|
||||
@@ -68,6 +68,7 @@ module psb_c_base_vect_mod
|
||||
procedure, pass(x) :: bld_n => c_base_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
procedure, pass(x) :: all => c_base_all
|
||||
procedure, pass(x) :: mold => c_base_mold
|
||||
!
|
||||
! Insert/set. Assembly and free.
|
||||
! Assembly does almost nothing here, but is important
|
||||
@@ -219,6 +220,18 @@ contains
|
||||
|
||||
end subroutine c_base_all
|
||||
|
||||
subroutine c_base_mold(x, y, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_c_base_vect_type), intent(in) :: x
|
||||
class(psb_c_base_vect_type), intent(out), allocatable :: y
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
allocate(psb_c_base_vect_type :: y, stat=info)
|
||||
|
||||
end subroutine c_base_mold
|
||||
|
||||
!
|
||||
! Insert a bunch of values at specified positions.
|
||||
!
|
||||
|
||||
@@ -100,7 +100,11 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_c_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -117,7 +121,11 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_c_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -411,7 +419,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_c_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -531,7 +543,11 @@ contains
|
||||
complex(psb_spk_), allocatable :: invect(:)
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
|
||||
@@ -68,6 +68,7 @@ module psb_d_base_vect_mod
|
||||
procedure, pass(x) :: bld_n => d_base_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
procedure, pass(x) :: all => d_base_all
|
||||
procedure, pass(x) :: mold => d_base_mold
|
||||
!
|
||||
! Insert/set. Assembly and free.
|
||||
! Assembly does almost nothing here, but is important
|
||||
@@ -219,6 +220,18 @@ contains
|
||||
|
||||
end subroutine d_base_all
|
||||
|
||||
subroutine d_base_mold(x, y, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_d_base_vect_type), intent(in) :: x
|
||||
class(psb_d_base_vect_type), intent(out), allocatable :: y
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
allocate(psb_d_base_vect_type :: y, stat=info)
|
||||
|
||||
end subroutine d_base_mold
|
||||
|
||||
!
|
||||
! Insert a bunch of values at specified positions.
|
||||
!
|
||||
|
||||
@@ -124,19 +124,6 @@ module psb_d_linmap_mod
|
||||
end function psb_d_linmap
|
||||
end interface
|
||||
|
||||
interface psb_linmaps
|
||||
subroutine psb_d_linmaps(mapout,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr)
|
||||
use psb_d_mat_mod, only : psb_dspmat_type
|
||||
import :: psb_ipk_, psb_dlinmap_type, psb_desc_type
|
||||
implicit none
|
||||
type(psb_dlinmap_type), intent(inout) :: mapout
|
||||
type(psb_desc_type), target :: desc_X, desc_Y
|
||||
type(psb_dspmat_type), intent(in) :: map_X2Y, map_Y2X
|
||||
integer(psb_ipk_), intent(in) :: map_kind
|
||||
integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:)
|
||||
end subroutine psb_d_linmaps
|
||||
end interface
|
||||
|
||||
private :: d_map_sizeof, d_is_asb, d_free
|
||||
|
||||
|
||||
|
||||
@@ -100,7 +100,11 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_d_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -117,7 +121,11 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_d_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -411,7 +419,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_d_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -531,7 +543,11 @@ contains
|
||||
real(psb_dpk_), allocatable :: invect(:)
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
|
||||
@@ -68,6 +68,7 @@ module psb_i_base_vect_mod
|
||||
procedure, pass(x) :: bld_n => i_base_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
procedure, pass(x) :: all => i_base_all
|
||||
procedure, pass(x) :: mold => i_base_mold
|
||||
!
|
||||
! Insert/set. Assembly and free.
|
||||
! Assembly does almost nothing here, but is important
|
||||
@@ -219,6 +220,18 @@ contains
|
||||
|
||||
end subroutine i_base_all
|
||||
|
||||
subroutine i_base_mold(x, y, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_i_base_vect_type), intent(in) :: x
|
||||
class(psb_i_base_vect_type), intent(out), allocatable :: y
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
allocate(psb_i_base_vect_type :: y, stat=info)
|
||||
|
||||
end subroutine i_base_mold
|
||||
|
||||
!
|
||||
! Insert a bunch of values at specified positions.
|
||||
!
|
||||
|
||||
@@ -100,7 +100,11 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_i_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -117,7 +121,11 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_i_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -411,7 +419,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_i_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -531,7 +543,11 @@ contains
|
||||
integer(psb_ipk_), allocatable :: invect(:)
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
|
||||
@@ -68,6 +68,7 @@ module psb_s_base_vect_mod
|
||||
procedure, pass(x) :: bld_n => s_base_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
procedure, pass(x) :: all => s_base_all
|
||||
procedure, pass(x) :: mold => s_base_mold
|
||||
!
|
||||
! Insert/set. Assembly and free.
|
||||
! Assembly does almost nothing here, but is important
|
||||
@@ -219,6 +220,18 @@ contains
|
||||
|
||||
end subroutine s_base_all
|
||||
|
||||
subroutine s_base_mold(x, y, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_s_base_vect_type), intent(in) :: x
|
||||
class(psb_s_base_vect_type), intent(out), allocatable :: y
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
allocate(psb_s_base_vect_type :: y, stat=info)
|
||||
|
||||
end subroutine s_base_mold
|
||||
|
||||
!
|
||||
! Insert a bunch of values at specified positions.
|
||||
!
|
||||
|
||||
@@ -100,7 +100,11 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_s_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -117,7 +121,11 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_s_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -411,7 +419,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_s_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -531,7 +543,11 @@ contains
|
||||
real(psb_spk_), allocatable :: invect(:)
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
|
||||
@@ -68,6 +68,7 @@ module psb_z_base_vect_mod
|
||||
procedure, pass(x) :: bld_n => z_base_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
procedure, pass(x) :: all => z_base_all
|
||||
procedure, pass(x) :: mold => z_base_mold
|
||||
!
|
||||
! Insert/set. Assembly and free.
|
||||
! Assembly does almost nothing here, but is important
|
||||
@@ -219,6 +220,18 @@ contains
|
||||
|
||||
end subroutine z_base_all
|
||||
|
||||
subroutine z_base_mold(x, y, info)
|
||||
use psi_serial_mod
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(psb_z_base_vect_type), intent(in) :: x
|
||||
class(psb_z_base_vect_type), intent(out), allocatable :: y
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
allocate(psb_z_base_vect_type :: y, stat=info)
|
||||
|
||||
end subroutine z_base_mold
|
||||
|
||||
!
|
||||
! Insert a bunch of values at specified positions.
|
||||
!
|
||||
|
||||
@@ -100,7 +100,11 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_z_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -117,7 +121,11 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_z_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -411,7 +419,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_z_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -531,7 +543,11 @@ contains
|
||||
complex(psb_dpk_), allocatable :: invect(:)
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
|
||||
@@ -79,7 +79,7 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info)
|
||||
do i=1,n_col
|
||||
vl(i) = i
|
||||
end do
|
||||
call desc%indxmap%l2g(vl(1:n_col),info)
|
||||
call desc%indxmap%l2gip(vl(1:n_col),info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
ierr(1)=info
|
||||
@@ -101,7 +101,7 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info)
|
||||
& call desc%indxmap%init(iictxt,vl(1:n_row),info)
|
||||
if (info == psb_success_) call psb_cd_set_bld(desc,info)
|
||||
if (info == psb_success_) &
|
||||
& call desc%indxmap%g2l_ins(vl(n_row+1:n_col),info)
|
||||
& call desc%indxmap%g2lip_ins(vl(n_row+1:n_col),info)
|
||||
if (info /= psb_success_) then
|
||||
ierr(1) = info
|
||||
call psb_errpush(psb_err_from_subroutine_ai_,name,&
|
||||
|
||||
@@ -179,7 +179,7 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact)
|
||||
endif
|
||||
act = psb_toupper(act)
|
||||
|
||||
call desc_a%indxmap%l2g(x,info)
|
||||
call desc_a%indxmap%l2gip(x,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
select case(act)
|
||||
|
||||
Reference in New Issue
Block a user