diff --git a/base/internals/psi_bld_tmphalo.f90 b/base/internals/psi_bld_tmphalo.f90 index b1f995e2..0b0667a4 100644 --- a/base/internals/psi_bld_tmphalo.f90 +++ b/base/internals/psi_bld_tmphalo.f90 @@ -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 diff --git a/base/internals/psi_idx_cnv.f90 b/base/internals/psi_idx_cnv.f90 index 009ed9a6..5ab5e448 100644 --- a/base/internals/psi_idx_cnv.f90 +++ b/base/internals/psi_idx_cnv.f90 @@ -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') diff --git a/base/internals/psi_idx_ins_cnv.f90 b/base/internals/psi_idx_ins_cnv.f90 index 85f72ee9..f156e0b6 100644 --- a/base/internals/psi_idx_ins_cnv.f90 +++ b/base/internals/psi_idx_ins_cnv.f90 @@ -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') diff --git a/base/modules/psb_c_base_vect_mod.f90 b/base/modules/psb_c_base_vect_mod.f90 index d0716d69..c84ce97a 100644 --- a/base/modules/psb_c_base_vect_mod.f90 +++ b/base/modules/psb_c_base_vect_mod.f90 @@ -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. ! diff --git a/base/modules/psb_c_vect_mod.F90 b/base/modules/psb_c_vect_mod.F90 index 6d52aa91..eb7ddeb4 100644 --- a/base/modules/psb_c_vect_mod.F90 +++ b/base/modules/psb_c_vect_mod.F90 @@ -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) diff --git a/base/modules/psb_d_base_vect_mod.f90 b/base/modules/psb_d_base_vect_mod.f90 index 2e5e3692..c66a592a 100644 --- a/base/modules/psb_d_base_vect_mod.f90 +++ b/base/modules/psb_d_base_vect_mod.f90 @@ -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. ! diff --git a/base/modules/psb_d_linmap_mod.f90 b/base/modules/psb_d_linmap_mod.f90 index c1da0fe6..d48694d6 100644 --- a/base/modules/psb_d_linmap_mod.f90 +++ b/base/modules/psb_d_linmap_mod.f90 @@ -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 diff --git a/base/modules/psb_d_vect_mod.F90 b/base/modules/psb_d_vect_mod.F90 index c2f1faa1..bfc97f81 100644 --- a/base/modules/psb_d_vect_mod.F90 +++ b/base/modules/psb_d_vect_mod.F90 @@ -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) diff --git a/base/modules/psb_i_base_vect_mod.f90 b/base/modules/psb_i_base_vect_mod.f90 index 8f1fb2c3..302b0563 100644 --- a/base/modules/psb_i_base_vect_mod.f90 +++ b/base/modules/psb_i_base_vect_mod.f90 @@ -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. ! diff --git a/base/modules/psb_i_vect_mod.F90 b/base/modules/psb_i_vect_mod.F90 index ce530bc3..885af03e 100644 --- a/base/modules/psb_i_vect_mod.F90 +++ b/base/modules/psb_i_vect_mod.F90 @@ -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) diff --git a/base/modules/psb_s_base_vect_mod.f90 b/base/modules/psb_s_base_vect_mod.f90 index a177d10f..a16e6252 100644 --- a/base/modules/psb_s_base_vect_mod.f90 +++ b/base/modules/psb_s_base_vect_mod.f90 @@ -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. ! diff --git a/base/modules/psb_s_vect_mod.F90 b/base/modules/psb_s_vect_mod.F90 index af502c4b..98e140d0 100644 --- a/base/modules/psb_s_vect_mod.F90 +++ b/base/modules/psb_s_vect_mod.F90 @@ -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) diff --git a/base/modules/psb_z_base_vect_mod.f90 b/base/modules/psb_z_base_vect_mod.f90 index 20494c51..c65d2dac 100644 --- a/base/modules/psb_z_base_vect_mod.f90 +++ b/base/modules/psb_z_base_vect_mod.f90 @@ -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. ! diff --git a/base/modules/psb_z_vect_mod.F90 b/base/modules/psb_z_vect_mod.F90 index 37513226..754bdb8c 100644 --- a/base/modules/psb_z_vect_mod.F90 +++ b/base/modules/psb_z_vect_mod.F90 @@ -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) diff --git a/base/tools/psb_cd_switch_ovl_indxmap.f90 b/base/tools/psb_cd_switch_ovl_indxmap.f90 index 1e80af10..3862c5dc 100644 --- a/base/tools/psb_cd_switch_ovl_indxmap.f90 +++ b/base/tools/psb_cd_switch_ovl_indxmap.f90 @@ -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,& diff --git a/base/tools/psb_loc_to_glob.f90 b/base/tools/psb_loc_to_glob.f90 index fde91279..857f04e4 100644 --- a/base/tools/psb_loc_to_glob.f90 +++ b/base/tools/psb_loc_to_glob.f90 @@ -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)