From 8cf8d5a4bc49477e7f9cc50f80c9ab964e0d33ec Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 30 Jan 2012 17:43:22 +0000 Subject: [PATCH] psblas3-integer8: base/modules/psb_c_linmap_mod.f90 base/modules/psb_d_linmap_mod.f90 base/modules/psb_desc_type.f90 base/modules/psb_error_impl.F90 base/modules/psb_error_mod.F90 base/modules/psb_gen_block_map_mod.f90 base/modules/psb_glist_map_mod.f90 base/modules/psb_hash_map_mod.f90 base/modules/psb_hash_mod.f90 base/modules/psb_indx_map_mod.f90 base/modules/psb_list_map_mod.f90 base/modules/psb_repl_map_mod.f90 base/modules/psb_s_linmap_mod.f90 base/modules/psb_z_linmap_mod.f90 base/modules/psi_bcast_mod.F90 base/modules/psi_i_mod.f90 After the fix to psi_reduce, all the other stuff in base/modules works with 4 bytes. Need to cross-check compilation on 8-bytes. --- base/modules/psb_c_linmap_mod.f90 | 18 +- base/modules/psb_d_linmap_mod.f90 | 2 - base/modules/psb_desc_type.f90 | 2 +- base/modules/psb_error_impl.F90 | 6 +- base/modules/psb_error_mod.F90 | 36 +- base/modules/psb_gen_block_map_mod.f90 | 16 +- base/modules/psb_glist_map_mod.f90 | 9 +- base/modules/psb_hash_map_mod.f90 | 1937 ++++++++++++------------ base/modules/psb_hash_mod.f90 | 3 +- base/modules/psb_indx_map_mod.f90 | 15 +- base/modules/psb_list_map_mod.f90 | 15 +- base/modules/psb_repl_map_mod.f90 | 10 +- base/modules/psb_s_linmap_mod.f90 | 2 - base/modules/psb_z_linmap_mod.f90 | 3 - base/modules/psi_bcast_mod.F90 | 114 +- base/modules/psi_i_mod.f90 | 7 +- 16 files changed, 1120 insertions(+), 1075 deletions(-) diff --git a/base/modules/psb_c_linmap_mod.f90 b/base/modules/psb_c_linmap_mod.f90 index d3efe916..27fda5ce 100644 --- a/base/modules/psb_c_linmap_mod.f90 +++ b/base/modules/psb_c_linmap_mod.f90 @@ -36,13 +36,13 @@ ! to different spaces. ! module psb_c_linmap_mod - + use psb_const_mod use psb_c_mat_mod, only : psb_cspmat_type use psb_descriptor_type, only : psb_desc_type use psb_base_linmap_mod - - + + type, extends(psb_base_linmap_type) :: psb_clinmap_type type(psb_cspmat_type) :: map_X2Y, map_Y2X contains @@ -75,7 +75,7 @@ module psb_c_linmap_mod integer(psb_ipk_), intent(out) :: info complex(psb_spk_), optional :: work(:) end subroutine psb_c_map_X2Y_vect - end interface + end interface psb_map_X2Y interface psb_map_Y2X subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work) @@ -100,20 +100,20 @@ module psb_c_linmap_mod integer(psb_ipk_), intent(out) :: info complex(psb_spk_), optional :: work(:) end subroutine psb_c_map_Y2X_vect - end interface + end interface psb_map_Y2X interface psb_map_cscnv module procedure psb_c_map_cscnv - end interface + end interface psb_map_cscnv interface psb_linmap_sub module procedure psb_c_linmap_sub - end interface + end interface psb_linmap_sub interface psb_move_alloc module procedure psb_clinmap_transfer - end interface + end interface psb_move_alloc interface psb_linmap function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) @@ -126,7 +126,7 @@ module psb_c_linmap_mod integer(psb_ipk_), intent(in) :: map_kind integer(psb_ipk_), intent(in), optional :: iaggr(:), naggr(:) end function psb_c_linmap - end interface + end interface psb_linmap private :: c_map_sizeof, c_is_asb, c_free diff --git a/base/modules/psb_d_linmap_mod.f90 b/base/modules/psb_d_linmap_mod.f90 index ac8598fd..cdae85b6 100644 --- a/base/modules/psb_d_linmap_mod.f90 +++ b/base/modules/psb_d_linmap_mod.f90 @@ -132,8 +132,6 @@ module psb_d_linmap_mod - - contains function d_map_sizeof(map) result(val) diff --git a/base/modules/psb_desc_type.f90 b/base/modules/psb_desc_type.f90 index 23c465c3..42450796 100644 --- a/base/modules/psb_desc_type.f90 +++ b/base/modules/psb_desc_type.f90 @@ -890,7 +890,7 @@ contains Do j=0,n_elem_recv-1 idx = idxlist(incnt+psb_elem_recv_+j) - call psb_ensure_size((outcnt+3),tmp,info,pad=-1) + call psb_ensure_size((outcnt+3),tmp,info,pad=-ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='psb_ensure_size') diff --git a/base/modules/psb_error_impl.F90 b/base/modules/psb_error_impl.F90 index e211eff7..702dc4e9 100644 --- a/base/modules/psb_error_impl.F90 +++ b/base/modules/psb_error_impl.F90 @@ -2,7 +2,7 @@ subroutine psb_errcomm(ictxt, err) use psb_error_mod, psb_protect_name => psb_errcomm use psb_penv_mod - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt integer(psb_ipk_), intent(inout):: err integer(psb_ipk_) :: temp(2) @@ -53,12 +53,12 @@ subroutine psb_perror(ictxt) use psb_error_mod use psb_penv_mod implicit none - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt integer(psb_ipk_) :: err_c character(len=20) :: r_name character(len=40) :: a_e_d integer(psb_ipk_) :: i_e_d(5) - integer(psb_ipk_) :: iam, np + integer(psb_mpik_) :: iam, np call psb_info(ictxt,iam,np) diff --git a/base/modules/psb_error_mod.F90 b/base/modules/psb_error_mod.F90 index edd77281..e16dea87 100644 --- a/base/modules/psb_error_mod.F90 +++ b/base/modules/psb_error_mod.F90 @@ -60,19 +60,28 @@ module psb_error_mod subroutine psb_serror() end subroutine psb_serror subroutine psb_perror(ictxt) - import :: psb_ipk_ - integer(psb_ipk_), intent(in) :: ictxt + import :: psb_mpik_ + integer(psb_mpik_), intent(in) :: ictxt end subroutine psb_perror end interface interface subroutine psb_errcomm(ictxt, err) - import :: psb_ipk_ - integer(psb_ipk_), intent(in) :: ictxt + import :: psb_mpik_, psb_ipk_ + integer(psb_mpik_), intent(in) :: ictxt integer(psb_ipk_), intent(inout):: err end subroutine psb_errcomm end interface +#if defined(LONG_INTEGERS) + interface psb_error + module procedure psb_perror_ipk + end interface psb_error + interface psb_errcomm + module procedure psb_errcomm_ipk + end interface psb_errcomm +#endif + private @@ -112,7 +121,22 @@ module psb_error_mod contains - +#if defined(LONG_INTEGERS) + subroutine psb_errcomm_ipk(ictxt, err) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(inout):: err + integer(psb_mpik_) :: iictxt + iictxt = ictxt + call psb_errcomm(iictxt,err) + end subroutine psb_errcomm_ipk + + subroutine psb_perror_ipk(ictxt) + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_) :: iictxt + iictxt = ictxt + call psb_perror(iictxt) + end subroutine psb_perror_ipk +#endif ! saves action to support error traceback ! also changes error action to "return" subroutine psb_erractionsave(err_act) @@ -330,7 +354,7 @@ contains character(len=20), intent(in) :: r_name character(len=40), intent(in) :: a_e_d integer(psb_ipk_), intent(in) :: i_e_d(5) - integer(psb_ipk_), optional :: me + integer(psb_mpik_), optional :: me if(present(me)) then write(psb_err_unit,& diff --git a/base/modules/psb_gen_block_map_mod.f90 b/base/modules/psb_gen_block_map_mod.f90 index 9b1737b8..498ba4e6 100644 --- a/base/modules/psb_gen_block_map_mod.f90 +++ b/base/modules/psb_gen_block_map_mod.f90 @@ -89,6 +89,7 @@ module psb_gen_block_map_mod & block_g2lv2, block_g2ls1_ins, block_g2ls2_ins,& & block_g2lv1_ins, block_g2lv2_ins, block_clone + integer(psb_ipk_), private :: laddsz=500 contains @@ -284,7 +285,7 @@ contains logical, intent(in), optional :: mask(:) logical, intent(in), optional :: owned integer(psb_ipk_) :: i, nv, is - integer(psb_ipk_) :: ictxt, iam, np + integer(psb_mpik_) :: ictxt, iam, np logical :: owned_ info = 0 @@ -476,7 +477,7 @@ contains ix = psb_issrch(idx(i),nv,idxmap%loc_to_glob) if (ix < 0) then ix = idxmap%local_cols + 1 - call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=500) + call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz) if (info /= 0) then info = -4 return @@ -505,7 +506,7 @@ contains ix = psb_issrch(idx(i),nv,idxmap%loc_to_glob) if (ix < 0) then ix = idxmap%local_cols + 1 - call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=500) + call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz) if (info /= 0) then info = -4 return @@ -582,10 +583,12 @@ contains use psb_error_mod implicit none class(psb_gen_block_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt, nl + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: nl integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_ipk_) :: iam, np, i, ntot + integer(psb_mpik_) :: iam, np + integer(psb_ipk_) :: i, ntot integer(psb_ipk_), allocatable :: vnl(:) info = 0 @@ -644,7 +647,8 @@ contains class(psb_gen_block_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: nhal, ictxt, iam, np + integer(psb_ipk_) :: nhal + integer(psb_mpik_) :: ictxt, iam, np info = 0 ictxt = idxmap%get_ctxt() diff --git a/base/modules/psb_glist_map_mod.f90 b/base/modules/psb_glist_map_mod.f90 index ee62dd8c..a71d82fb 100644 --- a/base/modules/psb_glist_map_mod.f90 +++ b/base/modules/psb_glist_map_mod.f90 @@ -96,10 +96,12 @@ contains use psb_error_mod implicit none class(psb_glist_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt, vg(:) + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: vg(:) integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_ipk_) :: iam, np, i, n, nl + integer(psb_mpik_) :: iam, np + integer(psb_ipk_) :: i, n, nl info = 0 @@ -155,7 +157,8 @@ contains integer(psb_ipk_), allocatable, intent(out) :: iprc(:) class(psb_glist_map), intent(in) :: idxmap integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, iam, np, nv, i, ngp + integer(psb_mpik_) :: ictxt, iam, np + integer(psb_ipk_) :: nv, i, ngp ictxt = idxmap%get_ctxt() call psb_info(ictxt,iam,np) diff --git a/base/modules/psb_hash_map_mod.f90 b/base/modules/psb_hash_map_mod.f90 index 03ced807..be083dd5 100644 --- a/base/modules/psb_hash_map_mod.f90 +++ b/base/modules/psb_hash_map_mod.f90 @@ -60,163 +60,179 @@ module psb_hash_map_mod type, extends(psb_indx_map) :: psb_hash_map - integer(psb_ipk_) :: hashvsize, hashvmask - integer(psb_ipk_), allocatable :: hashv(:), glb_lc(:,:), loc_to_glob(:) - type(psb_hash_type), allocatable :: hash + integer(psb_ipk_) :: hashvsize, hashvmask + integer(psb_ipk_), allocatable :: hashv(:), glb_lc(:,:), loc_to_glob(:) + type(psb_hash_type), allocatable :: hash -contains + contains + + procedure, pass(idxmap) :: init_vl => hash_init_vl + procedure, pass(idxmap) :: hash_map_init => hash_init_vg - procedure, pass(idxmap) :: init_vl => hash_init_vl - procedure, pass(idxmap) :: hash_map_init => hash_init_vg + procedure, pass(idxmap) :: sizeof => hash_sizeof + procedure, pass(idxmap) :: asb => hash_asb + procedure, pass(idxmap) :: free => hash_free + procedure, pass(idxmap) :: clone => hash_clone + procedure, nopass :: get_fmt => hash_get_fmt - procedure, pass(idxmap) :: sizeof => hash_sizeof - procedure, pass(idxmap) :: asb => hash_asb - procedure, pass(idxmap) :: free => hash_free - procedure, pass(idxmap) :: clone => hash_clone - procedure, nopass :: get_fmt => hash_get_fmt + procedure, nopass :: row_extendable => hash_row_extendable - procedure, nopass :: row_extendable => hash_row_extendable + procedure, pass(idxmap) :: l2gs1 => hash_l2gs1 + procedure, pass(idxmap) :: l2gs2 => hash_l2gs2 + procedure, pass(idxmap) :: l2gv1 => hash_l2gv1 + procedure, pass(idxmap) :: l2gv2 => hash_l2gv2 - procedure, pass(idxmap) :: l2gs1 => hash_l2gs1 - procedure, pass(idxmap) :: l2gs2 => hash_l2gs2 - procedure, pass(idxmap) :: l2gv1 => hash_l2gv1 - procedure, pass(idxmap) :: l2gv2 => hash_l2gv2 + procedure, pass(idxmap) :: g2ls1 => hash_g2ls1 + procedure, pass(idxmap) :: g2ls2 => hash_g2ls2 + procedure, pass(idxmap) :: g2lv1 => hash_g2lv1 + procedure, pass(idxmap) :: g2lv2 => hash_g2lv2 - procedure, pass(idxmap) :: g2ls1 => hash_g2ls1 - procedure, pass(idxmap) :: g2ls2 => hash_g2ls2 - procedure, pass(idxmap) :: g2lv1 => hash_g2lv1 - procedure, pass(idxmap) :: g2lv2 => hash_g2lv2 + procedure, pass(idxmap) :: g2ls1_ins => hash_g2ls1_ins + procedure, pass(idxmap) :: g2ls2_ins => hash_g2ls2_ins + procedure, pass(idxmap) :: g2lv1_ins => hash_g2lv1_ins + procedure, pass(idxmap) :: g2lv2_ins => hash_g2lv2_ins - procedure, pass(idxmap) :: g2ls1_ins => hash_g2ls1_ins - procedure, pass(idxmap) :: g2ls2_ins => hash_g2ls2_ins - procedure, pass(idxmap) :: g2lv1_ins => hash_g2lv1_ins - procedure, pass(idxmap) :: g2lv2_ins => hash_g2lv2_ins + procedure, pass(idxmap) :: bld_g2l_map => hash_bld_g2l_map - procedure, pass(idxmap) :: bld_g2l_map => hash_bld_g2l_map + end type psb_hash_map -end type psb_hash_map + private :: hash_init_vl, hash_init_vg, hash_sizeof, hash_asb, & + & hash_free, hash_get_fmt, hash_l2gs1, hash_l2gs2, & + & hash_l2gv1, hash_l2gv2, hash_g2ls1, hash_g2ls2, & + & hash_g2lv1, hash_g2lv2, hash_g2ls1_ins, hash_g2ls2_ins, & + & hash_g2lv1_ins, hash_g2lv2_ins, hash_init_vlu, & + & hash_bld_g2l_map, hash_inner_cnvs1, hash_inner_cnvs2,& + & hash_inner_cnv1, hash_inner_cnv2, hash_row_extendable -private :: hash_init_vl, hash_init_vg, hash_sizeof, hash_asb, & - & hash_free, hash_get_fmt, hash_l2gs1, hash_l2gs2, & - & hash_l2gv1, hash_l2gv2, hash_g2ls1, hash_g2ls2, & - & hash_g2lv1, hash_g2lv2, hash_g2ls1_ins, hash_g2ls2_ins, & - & hash_g2lv1_ins, hash_g2lv2_ins, hash_init_vlu, & - & hash_bld_g2l_map, hash_inner_cnvs1, hash_inner_cnvs2,& - & hash_inner_cnv1, hash_inner_cnv2, hash_row_extendable + integer(psb_ipk_), private :: laddsz=500 -interface hash_inner_cnv - module procedure hash_inner_cnvs1, hash_inner_cnvs2,& - & hash_inner_cnv1, hash_inner_cnv2 -end interface hash_inner_cnv -private :: hash_inner_cnv + interface hash_inner_cnv + module procedure hash_inner_cnvs1, hash_inner_cnvs2,& + & hash_inner_cnv1, hash_inner_cnv2 + end interface hash_inner_cnv + private :: hash_inner_cnv contains -function hash_row_extendable() result(val) - implicit none - logical :: val - val = .true. -end function hash_row_extendable - -function hash_sizeof(idxmap) result(val) - implicit none - class(psb_hash_map), intent(in) :: idxmap - integer(psb_long_int_k_) :: val - - val = idxmap%psb_indx_map%sizeof() - val = val + 2 * psb_sizeof_int - if (allocated(idxmap%hashv)) & - & val = val + size(idxmap%hashv)*psb_sizeof_int - if (allocated(idxmap%glb_lc)) & - & val = val + size(idxmap%glb_lc)*psb_sizeof_int - if (allocated(idxmap%hash)) & - & val = val + psb_sizeof(idxmap%hash) - -end function hash_sizeof - - -subroutine hash_free(idxmap) - implicit none - class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_) :: info - - if (allocated(idxmap%hashv)) & - & deallocate(idxmap%hashv) - if (allocated(idxmap%glb_lc)) & - & deallocate(idxmap%glb_lc) - - if (allocated(idxmap%hash)) then - call psb_free(idxmap%hash,info) - deallocate(idxmap%hash) - end if - - call idxmap%psb_indx_map%free() - -end subroutine hash_free - - -subroutine hash_l2gs1(idx,idxmap,info,mask,owned) - implicit none - class(psb_hash_map), intent(in) :: idxmap - integer(psb_ipk_), intent(inout) :: idx - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - logical, intent(in), optional :: owned - integer(psb_ipk_) :: idxv(1) - info = 0 - if (present(mask)) then - if (.not.mask) return - end if - - idxv(1) = idx - call idxmap%l2g(idxv,info,owned=owned) - idx = idxv(1) - -end subroutine hash_l2gs1 - -subroutine hash_l2gs2(idxin,idxout,idxmap,info,mask,owned) - implicit none - class(psb_hash_map), intent(in) :: idxmap - integer(psb_ipk_), intent(in) :: idxin - integer(psb_ipk_), intent(out) :: idxout - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - logical, intent(in), optional :: owned - - idxout = idxin - call idxmap%l2g(idxout,info,mask,owned) - -end subroutine hash_l2gs2 - - -subroutine hash_l2gv1(idx,idxmap,info,mask,owned) - implicit none - class(psb_hash_map), intent(in) :: idxmap - integer(psb_ipk_), intent(inout) :: idx(:) - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned - integer(psb_ipk_) :: i - logical :: owned_ - info = 0 - - if (present(mask)) then - if (size(mask) < size(idx)) then - info = -1 - return + function hash_row_extendable() result(val) + implicit none + logical :: val + val = .true. + end function hash_row_extendable + + function hash_sizeof(idxmap) result(val) + implicit none + class(psb_hash_map), intent(in) :: idxmap + integer(psb_long_int_k_) :: val + + val = idxmap%psb_indx_map%sizeof() + val = val + 2 * psb_sizeof_int + if (allocated(idxmap%hashv)) & + & val = val + size(idxmap%hashv)*psb_sizeof_int + if (allocated(idxmap%glb_lc)) & + & val = val + size(idxmap%glb_lc)*psb_sizeof_int + if (allocated(idxmap%hash)) & + & val = val + psb_sizeof(idxmap%hash) + + end function hash_sizeof + + + subroutine hash_free(idxmap) + implicit none + class(psb_hash_map), intent(inout) :: idxmap + integer(psb_ipk_) :: info + + if (allocated(idxmap%hashv)) & + & deallocate(idxmap%hashv) + if (allocated(idxmap%glb_lc)) & + & deallocate(idxmap%glb_lc) + + if (allocated(idxmap%hash)) then + call psb_free(idxmap%hash,info) + deallocate(idxmap%hash) end if - end if - if (present(owned)) then - owned_ = owned - else - owned_ = .false. - end if - if (present(mask)) then + call idxmap%psb_indx_map%free() + + end subroutine hash_free + + + subroutine hash_l2gs1(idx,idxmap,info,mask,owned) + implicit none + class(psb_hash_map), intent(in) :: idxmap + integer(psb_ipk_), intent(inout) :: idx + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask + logical, intent(in), optional :: owned + integer(psb_ipk_) :: idxv(1) + info = 0 + if (present(mask)) then + if (.not.mask) return + end if + + idxv(1) = idx + call idxmap%l2g(idxv,info,owned=owned) + idx = idxv(1) + + end subroutine hash_l2gs1 + + subroutine hash_l2gs2(idxin,idxout,idxmap,info,mask,owned) + implicit none + class(psb_hash_map), intent(in) :: idxmap + integer(psb_ipk_), intent(in) :: idxin + integer(psb_ipk_), intent(out) :: idxout + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask + logical, intent(in), optional :: owned + + idxout = idxin + call idxmap%l2g(idxout,info,mask,owned) + + end subroutine hash_l2gs2 + + + subroutine hash_l2gv1(idx,idxmap,info,mask,owned) + implicit none + class(psb_hash_map), intent(in) :: idxmap + integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned + integer(psb_ipk_) :: i + logical :: owned_ + info = 0 + + if (present(mask)) then + if (size(mask) < size(idx)) then + info = -1 + return + end if + end if + if (present(owned)) then + owned_ = owned + else + owned_ = .false. + end if + + if (present(mask)) then + + do i=1, size(idx) + if (mask(i)) then + if ((1<=idx(i)).and.(idx(i) <= idxmap%local_rows)) then + idx(i) = idxmap%loc_to_glob(idx(i)) + else if ((idxmap%local_rows < idx(i)).and.(idx(i) <= idxmap%local_cols)& + & .and.(.not.owned_)) then + idx(i) = idxmap%loc_to_glob(idx(i)) + else + idx(i) = -1 + end if + end if + end do - do i=1, size(idx) - if (mask(i)) then + else if (.not.present(mask)) then + + do i=1, size(idx) if ((1<=idx(i)).and.(idx(i) <= idxmap%local_rows)) then idx(i) = idxmap%loc_to_glob(idx(i)) else if ((idxmap%local_rows < idx(i)).and.(idx(i) <= idxmap%local_cols)& @@ -225,133 +241,155 @@ subroutine hash_l2gv1(idx,idxmap,info,mask,owned) else idx(i) = -1 end if - end if - end do + end do - else if (.not.present(mask)) then + end if - do i=1, size(idx) - if ((1<=idx(i)).and.(idx(i) <= idxmap%local_rows)) then - idx(i) = idxmap%loc_to_glob(idx(i)) - else if ((idxmap%local_rows < idx(i)).and.(idx(i) <= idxmap%local_cols)& - & .and.(.not.owned_)) then - idx(i) = idxmap%loc_to_glob(idx(i)) - else - idx(i) = -1 + end subroutine hash_l2gv1 + + subroutine hash_l2gv2(idxin,idxout,idxmap,info,mask,owned) + implicit none + class(psb_hash_map), intent(in) :: idxmap + integer(psb_ipk_), intent(in) :: idxin(:) + integer(psb_ipk_), intent(out) :: idxout(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned + integer(psb_ipk_) :: is, im + + is = size(idxin) + im = min(is,size(idxout)) + idxout(1:im) = idxin(1:im) + call idxmap%l2g(idxout(1:im),info,mask,owned) + if (is > im) then + write(0,*) 'l2gv2 err -3' + info = -3 + end if + + end subroutine hash_l2gv2 + + + subroutine hash_g2ls1(idx,idxmap,info,mask,owned) + implicit none + class(psb_hash_map), intent(in) :: idxmap + integer(psb_ipk_), intent(inout) :: idx + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask + logical, intent(in), optional :: owned + integer(psb_ipk_) :: idxv(1) + info = 0 + + if (present(mask)) then + if (.not.mask) return + end if + + idxv(1) = idx + call idxmap%g2l(idxv,info,owned=owned) + idx = idxv(1) + + end subroutine hash_g2ls1 + + subroutine hash_g2ls2(idxin,idxout,idxmap,info,mask,owned) + implicit none + class(psb_hash_map), intent(in) :: idxmap + integer(psb_ipk_), intent(in) :: idxin + integer(psb_ipk_), intent(out) :: idxout + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask + logical, intent(in), optional :: owned + + idxout = idxin + call idxmap%g2l(idxout,info,mask,owned) + + end subroutine hash_g2ls2 + + + subroutine hash_g2lv1(idx,idxmap,info,mask,owned) + use psb_penv_mod + use psb_sort_mod + implicit none + class(psb_hash_map), intent(in) :: idxmap + integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned + integer(psb_ipk_) :: i, is, mglob, ip, lip, nrow, ncol, nrm + integer(psb_mpik_) :: ictxt, iam, np + logical :: owned_ + + info = 0 + ictxt = idxmap%get_ctxt() + call psb_info(ictxt,iam,np) + + if (present(mask)) then + if (size(mask) < size(idx)) then + info = -1 + return end if - end do + end if + if (present(owned)) then + owned_ = owned + else + owned_ = .false. + end if - end if - -end subroutine hash_l2gv1 - -subroutine hash_l2gv2(idxin,idxout,idxmap,info,mask,owned) - implicit none - class(psb_hash_map), intent(in) :: idxmap - integer(psb_ipk_), intent(in) :: idxin(:) - integer(psb_ipk_), intent(out) :: idxout(:) - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned - integer(psb_ipk_) :: is, im - - is = size(idxin) - im = min(is,size(idxout)) - idxout(1:im) = idxin(1:im) - call idxmap%l2g(idxout(1:im),info,mask,owned) - if (is > im) then - write(0,*) 'l2gv2 err -3' - info = -3 - end if - -end subroutine hash_l2gv2 - - -subroutine hash_g2ls1(idx,idxmap,info,mask,owned) - implicit none - class(psb_hash_map), intent(in) :: idxmap - integer(psb_ipk_), intent(inout) :: idx - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - logical, intent(in), optional :: owned - integer(psb_ipk_) :: idxv(1) - info = 0 - - if (present(mask)) then - if (.not.mask) return - end if - - idxv(1) = idx - call idxmap%g2l(idxv,info,owned=owned) - idx = idxv(1) - -end subroutine hash_g2ls1 - -subroutine hash_g2ls2(idxin,idxout,idxmap,info,mask,owned) - implicit none - class(psb_hash_map), intent(in) :: idxmap - integer(psb_ipk_), intent(in) :: idxin - integer(psb_ipk_), intent(out) :: idxout - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - logical, intent(in), optional :: owned - - idxout = idxin - call idxmap%g2l(idxout,info,mask,owned) - -end subroutine hash_g2ls2 - - -subroutine hash_g2lv1(idx,idxmap,info,mask,owned) - use psb_penv_mod - use psb_sort_mod - implicit none - class(psb_hash_map), intent(in) :: idxmap - integer(psb_ipk_), intent(inout) :: idx(:) - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned - integer(psb_ipk_) :: i, is, mglob, ip, lip, nrow, ncol, nrm - integer(psb_ipk_) :: ictxt, iam, np - logical :: owned_ - - info = 0 - ictxt = idxmap%get_ctxt() - call psb_info(ictxt,iam,np) - - if (present(mask)) then - if (size(mask) < size(idx)) then - info = -1 - return + is = size(idx) + + mglob = idxmap%get_gr() + nrow = idxmap%get_lr() + ncol = idxmap%get_lc() + if (owned_) then + nrm = nrow + else + nrm = ncol end if - end if - if (present(owned)) then - owned_ = owned - else - owned_ = .false. - end if + if (present(mask)) then - is = size(idx) + if (idxmap%is_asb()) then - mglob = idxmap%get_gr() - nrow = idxmap%get_lr() - ncol = idxmap%get_lc() - if (owned_) then - nrm = nrow - else - nrm = ncol - end if - if (present(mask)) then + call hash_inner_cnv(is,idx,idxmap%hashvmask,& + & idxmap%hashv,idxmap%glb_lc,mask=mask, nrm=nrm) - if (idxmap%is_asb()) then + else if (idxmap%is_valid()) then - call hash_inner_cnv(is,idx,idxmap%hashvmask,& - & idxmap%hashv,idxmap%glb_lc,mask=mask, nrm=nrm) + do i = 1, is + if (mask(i)) then + ip = idx(i) + if ((ip < 1 ).or.(ip>mglob)) then + idx(i) = -1 + cycle + endif + call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,idxmap%glb_lc,nrm) + if (lip < 0) & + & call psb_hash_searchkey(ip,lip,idxmap%hash,info) + if (owned_) then + if (lip<=nrow) then + idx(i) = lip + else + idx(i) = -1 + endif + else + idx(i) = lip + endif + end if + enddo - else if (idxmap%is_valid()) then + else + write(0,*) 'Hash status: invalid ',idxmap%get_state() + idx(1:is) = -1 + info = -1 + end if - do i = 1, is - if (mask(i)) then + else if (.not.present(mask)) then + + if (idxmap%is_asb()) then + + call hash_inner_cnv(is,idx,idxmap%hashvmask,& + & idxmap%hashv,idxmap%glb_lc,nrm=nrm) + + else if (idxmap%is_valid()) then + + do i = 1, is ip = idx(i) if ((ip < 1 ).or.(ip>mglob)) then idx(i) = -1 @@ -369,153 +407,159 @@ subroutine hash_g2lv1(idx,idxmap,info,mask,owned) else idx(i) = lip endif - end if - enddo + enddo + + else + write(0,*) 'Hash status: invalid ',idxmap%get_state() + idx(1:is) = -1 + info = -1 + + end if - else - write(0,*) 'Hash status: invalid ',idxmap%get_state() - idx(1:is) = -1 - info = -1 end if - else if (.not.present(mask)) then + end subroutine hash_g2lv1 - if (idxmap%is_asb()) then + subroutine hash_g2lv2(idxin,idxout,idxmap,info,mask,owned) + implicit none + class(psb_hash_map), intent(in) :: idxmap + integer(psb_ipk_), intent(in) :: idxin(:) + integer(psb_ipk_), intent(out) :: idxout(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned + + integer(psb_ipk_) :: is, im + + is = size(idxin) + im = min(is,size(idxout)) + idxout(1:im) = idxin(1:im) + call idxmap%g2l(idxout(1:im),info,mask,owned) + if (is > im) then + write(0,*) 'g2lv2 err -3' + info = -3 + end if - call hash_inner_cnv(is,idx,idxmap%hashvmask,& - & idxmap%hashv,idxmap%glb_lc,nrm=nrm) + end subroutine hash_g2lv2 - else if (idxmap%is_valid()) then - do i = 1, is - ip = idx(i) - if ((ip < 1 ).or.(ip>mglob)) then - idx(i) = -1 - cycle - endif - call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,idxmap%glb_lc,nrm) - if (lip < 0) & - & call psb_hash_searchkey(ip,lip,idxmap%hash,info) - if (owned_) then - if (lip<=nrow) then - idx(i) = lip - else - idx(i) = -1 - endif - else - idx(i) = lip - endif - enddo - else - write(0,*) 'Hash status: invalid ',idxmap%get_state() - idx(1:is) = -1 - info = -1 + subroutine hash_g2ls1_ins(idx,idxmap,info,mask) + use psb_realloc_mod + use psb_sort_mod + implicit none + class(psb_hash_map), intent(inout) :: idxmap + integer(psb_ipk_), intent(inout) :: idx + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask - end if + integer(psb_ipk_) :: idxv(1) - end if - -end subroutine hash_g2lv1 - -subroutine hash_g2lv2(idxin,idxout,idxmap,info,mask,owned) - implicit none - class(psb_hash_map), intent(in) :: idxmap - integer(psb_ipk_), intent(in) :: idxin(:) - integer(psb_ipk_), intent(out) :: idxout(:) - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned - - integer(psb_ipk_) :: is, im - - is = size(idxin) - im = min(is,size(idxout)) - idxout(1:im) = idxin(1:im) - call idxmap%g2l(idxout(1:im),info,mask,owned) - if (is > im) then - write(0,*) 'g2lv2 err -3' - info = -3 - end if - -end subroutine hash_g2lv2 - - - -subroutine hash_g2ls1_ins(idx,idxmap,info,mask) - use psb_realloc_mod - use psb_sort_mod - implicit none - class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(inout) :: idx - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - - integer(psb_ipk_) :: idxv(1) - - info = 0 - if (present(mask)) then - if (.not.mask) return - end if - idxv(1) = idx - call idxmap%g2l_ins(idxv,info) - idx = idxv(1) - -end subroutine hash_g2ls1_ins - -subroutine hash_g2ls2_ins(idxin,idxout,idxmap,info,mask) - implicit none - class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: idxin - integer(psb_ipk_), intent(out) :: idxout - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - - idxout = idxin - call idxmap%g2l_ins(idxout,info,mask=mask) - -end subroutine hash_g2ls2_ins - - -subroutine hash_g2lv1_ins(idx,idxmap,info,mask) - use psb_error_mod - use psb_realloc_mod - use psb_sort_mod - use psb_penv_mod - implicit none - class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(inout) :: idx(:) - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - integer(psb_ipk_) :: i, is, mglob, ip, lip, nrow, ncol, & - & nxt, err_act, ictxt, me, np - character(len=20) :: name,ch_err - - info = psb_success_ - name = 'hash_g2l_ins' - call psb_erractionsave(err_act) - - ictxt = idxmap%get_ctxt() - call psb_info(ictxt, me, np) - - is = size(idx) - - if (present(mask)) then - if (size(mask) < size(idx)) then - info = -1 - return + info = 0 + if (present(mask)) then + if (.not.mask) return end if - end if + idxv(1) = idx + call idxmap%g2l_ins(idxv,info) + idx = idxv(1) + + end subroutine hash_g2ls1_ins + + subroutine hash_g2ls2_ins(idxin,idxout,idxmap,info,mask) + implicit none + class(psb_hash_map), intent(inout) :: idxmap + integer(psb_ipk_), intent(in) :: idxin + integer(psb_ipk_), intent(out) :: idxout + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask + + idxout = idxin + call idxmap%g2l_ins(idxout,info,mask=mask) + + end subroutine hash_g2ls2_ins + + + subroutine hash_g2lv1_ins(idx,idxmap,info,mask) + use psb_error_mod + use psb_realloc_mod + use psb_sort_mod + use psb_penv_mod + implicit none + class(psb_hash_map), intent(inout) :: idxmap + integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) + integer(psb_ipk_) :: i, is, mglob, ip, lip, nrow, ncol, & + & nxt, err_act + integer(psb_mpik_) :: ictxt, me, np + character(len=20) :: name,ch_err + info = psb_success_ + name = 'hash_g2l_ins' + call psb_erractionsave(err_act) + + ictxt = idxmap%get_ctxt() + call psb_info(ictxt, me, np) - mglob = idxmap%get_gr() - nrow = idxmap%get_lr() - if (idxmap%is_bld()) then + is = size(idx) if (present(mask)) then - do i = 1, is - ncol = idxmap%get_lc() - if (mask(i)) then + if (size(mask) < size(idx)) then + info = -1 + return + end if + end if + + + mglob = idxmap%get_gr() + nrow = idxmap%get_lr() + if (idxmap%is_bld()) then + + if (present(mask)) then + do i = 1, is + ncol = idxmap%get_lc() + if (mask(i)) then + ip = idx(i) + if ((ip < 1 ).or.(ip>mglob)) then + idx(i) = -1 + cycle + endif + nxt = ncol + 1 + call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,idxmap%glb_lc,ncol) + if (lip < 0) & + & call psb_hash_searchinskey(ip,lip,nxt,idxmap%hash,info) + + if (info >=0) then + if (nxt == lip) then + ncol = nxt + call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-ione,addsz=laddsz) + if (info /= psb_success_) then + info=1 + ch_err='psb_ensure_size' + call psb_errpush(psb_err_from_subroutine_ai_,name,& + &a_err=ch_err,i_err=(/info,izero,izero,izero,izero/)) + goto 9999 + end if + idxmap%loc_to_glob(nxt) = ip + call idxmap%set_lc(ncol) + endif + info = psb_success_ + else + ch_err='SearchInsKeyVal' + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err=ch_err,i_err=(/info,izero,izero,izero,izero/)) + goto 9999 + end if + idx(i) = lip + info = psb_success_ + else + idx(i) = -1 + end if + enddo + + else + do i = 1, is + ncol = idxmap%get_lc() ip = idx(i) if ((ip < 1 ).or.(ip>mglob)) then idx(i) = -1 @@ -529,12 +573,12 @@ subroutine hash_g2lv1_ins(idx,idxmap,info,mask) if (info >=0) then if (nxt == lip) then ncol = nxt - call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-1,addsz=200) + call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-ione,addsz=laddsz) if (info /= psb_success_) then info=1 ch_err='psb_ensure_size' call psb_errpush(psb_err_from_subroutine_ai_,name,& - &a_err=ch_err,i_err=(/info,0,0,0,0/)) + &a_err=ch_err,i_err=(/info,izero,izero,izero,izero/)) goto 9999 end if idxmap%loc_to_glob(nxt) = ip @@ -544,525 +588,529 @@ subroutine hash_g2lv1_ins(idx,idxmap,info,mask) else ch_err='SearchInsKeyVal' call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err=ch_err,i_err=(/info,0,0,0,0/)) + & a_err=ch_err,i_err=(/info,izero,izero,izero,izero/)) goto 9999 end if idx(i) = lip info = psb_success_ - else - idx(i) = -1 - end if - enddo + enddo - else - do i = 1, is - ncol = idxmap%get_lc() - ip = idx(i) - if ((ip < 1 ).or.(ip>mglob)) then - idx(i) = -1 - cycle - endif - nxt = ncol + 1 - call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,idxmap%glb_lc,ncol) - if (lip < 0) & - & call psb_hash_searchinskey(ip,lip,nxt,idxmap%hash,info) - - if (info >=0) then - if (nxt == lip) then - ncol = nxt - call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-1,addsz=200) - if (info /= psb_success_) then - info=1 - ch_err='psb_ensure_size' - call psb_errpush(psb_err_from_subroutine_ai_,name,& - &a_err=ch_err,i_err=(/info,0,0,0,0/)) - goto 9999 - end if - idxmap%loc_to_glob(nxt) = ip - call idxmap%set_lc(ncol) - endif - info = psb_success_ - else - ch_err='SearchInsKeyVal' - call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err=ch_err,i_err=(/info,0,0,0,0/)) - goto 9999 - end if - idx(i) = lip - info = psb_success_ - enddo + end if + else + ! Wrong state + idx = -1 + info = -1 end if - - else - ! Wrong state - idx = -1 - info = -1 - end if - call psb_erractionrestore(err_act) - return + call psb_erractionrestore(err_act) + return 9999 continue - call psb_erractionrestore(err_act) + call psb_erractionrestore(err_act) - if (err_act == psb_act_ret_) then - return - else - call psb_error(ictxt) - end if - return - -end subroutine hash_g2lv1_ins - -subroutine hash_g2lv2_ins(idxin,idxout,idxmap,info,mask) - implicit none - class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: idxin(:) - integer(psb_ipk_), intent(out) :: idxout(:) - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - integer(psb_ipk_) :: is, im - - is = size(idxin) - im = min(is,size(idxout)) - idxout(1:im) = idxin(1:im) - call idxmap%g2l_ins(idxout(1:im),info,mask) - if (is > im) then - write(0,*) 'g2lv2_ins err -3' - info = -3 - end if - -end subroutine hash_g2lv2_ins - -subroutine hash_init_vl(idxmap,ictxt,vl,info) - use psb_penv_mod - use psb_error_mod - use psb_sort_mod - use psb_realloc_mod - implicit none - class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt, vl(:) - integer(psb_ipk_), intent(out) :: info - ! To be implemented - integer(psb_ipk_) :: iam, np, i, nlu, nl, m, nrt,int_err(5) - integer(psb_ipk_), allocatable :: vlu(:) - character(len=20), parameter :: name='hash_map_init_vl' - - info = 0 - call psb_info(ictxt,iam,np) - if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:',ictxt - info = -1 + if (err_act == psb_act_ret_) then + return + else + call psb_error(ictxt) + end if return - end if - nl = size(vl) + end subroutine hash_g2lv1_ins - m = maxval(vl(1:nl)) - nrt = nl - call psb_sum(ictxt,nrt) - call psb_max(ictxt,m) + subroutine hash_g2lv2_ins(idxin,idxout,idxmap,info,mask) + implicit none + class(psb_hash_map), intent(inout) :: idxmap + integer(psb_ipk_), intent(in) :: idxin(:) + integer(psb_ipk_), intent(out) :: idxout(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) + integer(psb_ipk_) :: is, im + + is = size(idxin) + im = min(is,size(idxout)) + idxout(1:im) = idxin(1:im) + call idxmap%g2l_ins(idxout(1:im),info,mask) + if (is > im) then + write(0,*) 'g2lv2_ins err -3' + info = -3 + end if - allocate(vlu(nl), stat=info) - if (info /= 0) then - info = -1 - return - end if - - do i=1,nl - if ((vl(i)<1).or.(vl(i)>m)) then - info = psb_err_entry_out_of_bounds_ - int_err(1) = i - int_err(2) = vl(i) - int_err(3) = nl - int_err(4) = m - exit - endif - vlu(i) = vl(i) - end do - - if ((m /= nrt).and.(iam == psb_root_)) then - write(psb_err_unit,*) trim(name),& - & ' Warning: globalcheck=.false., but there is a mismatch' - write(psb_err_unit,*) trim(name),& - & ' : in the global sizes!',m,nrt - end if - ! - ! Now sort the input items, and check for duplicates - ! (unlikely, but possible) - ! - call psb_msort_unique(vlu,nlu) - if (nlu /= nl) then - write(0,*) 'Warning: duplicates in input' - end if - - call hash_init_vlu(idxmap,ictxt,m,nlu,vlu,info) - -end subroutine hash_init_vl - -subroutine hash_init_vg(idxmap,ictxt,vg,info) - use psb_penv_mod - use psb_error_mod - implicit none - class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt, vg(:) - integer(psb_ipk_), intent(out) :: info - ! To be implemented - integer(psb_ipk_) :: iam, np, i, j, nl, n, int_err(5) - integer(psb_ipk_), allocatable :: vlu(:) - - info = 0 - call psb_info(ictxt,iam,np) - if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:',ictxt - info = -1 - return - end if - - n = size(vg) - nl = 0 - do i=1, n - if ((vg(i)<0).or.(vg(i)>=np)) then - info = psb_err_partfunc_wrong_pid_ - int_err(1) = 3 - int_err(2) = vg(i) - int_err(3) = i - exit - endif - if (vg(i) == iam) nl = nl + 1 - end do + end subroutine hash_g2lv2_ins - allocate(vlu(nl), stat=info) - if (info /= 0) then - info = -1 - return - end if + subroutine hash_init_vl(idxmap,ictxt,vl,info) + use psb_penv_mod + use psb_error_mod + use psb_sort_mod + use psb_realloc_mod + implicit none + class(psb_hash_map), intent(inout) :: idxmap + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: vl(:) + integer(psb_ipk_), intent(out) :: info + ! To be implemented + integer(psb_mpik_) :: iam, np + integer(psb_ipk_) :: i, nlu, nl, m, nrt,int_err(5) + integer(psb_ipk_), allocatable :: vlu(:) + character(len=20), parameter :: name='hash_map_init_vl' + + info = 0 + call psb_info(ictxt,iam,np) + if (np < 0) then + write(psb_err_unit,*) 'Invalid ictxt:',ictxt + info = -1 + return + end if - j = 0 - do i=1, n - if (vg(i) == iam) then - j = j + 1 - vlu(j) = i + nl = size(vl) + + m = maxval(vl(1:nl)) + nrt = nl + call psb_sum(ictxt,nrt) + call psb_max(ictxt,m) + + allocate(vlu(nl), stat=info) + if (info /= 0) then + info = -1 + return end if - end do + do i=1,nl + if ((vl(i)<1).or.(vl(i)>m)) then + info = psb_err_entry_out_of_bounds_ + int_err(1) = i + int_err(2) = vl(i) + int_err(3) = nl + int_err(4) = m + exit + endif + vlu(i) = vl(i) + end do - call hash_init_vlu(idxmap,ictxt,n,nl,vlu,info) + if ((m /= nrt).and.(iam == psb_root_)) then + write(psb_err_unit,*) trim(name),& + & ' Warning: globalcheck=.false., but there is a mismatch' + write(psb_err_unit,*) trim(name),& + & ' : in the global sizes!',m,nrt + end if + ! + ! Now sort the input items, and check for duplicates + ! (unlikely, but possible) + ! + call psb_msort_unique(vlu,nlu) + if (nlu /= nl) then + write(0,*) 'Warning: duplicates in input' + end if + call hash_init_vlu(idxmap,ictxt,m,nlu,vlu,info) -end subroutine hash_init_vg + end subroutine hash_init_vl + subroutine hash_init_vg(idxmap,ictxt,vg,info) + use psb_penv_mod + use psb_error_mod + implicit none + class(psb_hash_map), intent(inout) :: idxmap + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: vg(:) + integer(psb_ipk_), intent(out) :: info + ! To be implemented + integer(psb_mpik_) :: iam, np + integer(psb_ipk_) :: i, j, nl, n, int_err(5) + integer(psb_ipk_), allocatable :: vlu(:) + + info = 0 + call psb_info(ictxt,iam,np) + if (np < 0) then + write(psb_err_unit,*) 'Invalid ictxt:',ictxt + info = -1 + return + end if -subroutine hash_init_vlu(idxmap,ictxt,ntot,nl,vlu,info) - use psb_penv_mod - use psb_error_mod - use psb_sort_mod - use psb_realloc_mod - implicit none - class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt, vlu(:), nl, ntot - integer(psb_ipk_), intent(out) :: info - ! To be implemented - integer(psb_ipk_) :: iam, np, i, j, lc2, nlu, m, nrt,int_err(5) - character(len=20), parameter :: name='hash_map_init_vlu' + n = size(vg) + nl = 0 + do i=1, n + if ((vg(i)<0).or.(vg(i)>=np)) then + info = psb_err_partfunc_wrong_pid_ + int_err(1) = 3 + int_err(2) = vg(i) + int_err(3) = i + exit + endif + if (vg(i) == iam) nl = nl + 1 + end do - info = 0 - call psb_info(ictxt,iam,np) - if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:',ictxt - info = -1 - return - end if - - idxmap%global_rows = ntot - idxmap%global_cols = ntot - idxmap%local_rows = nl - idxmap%local_cols = nl - idxmap%ictxt = ictxt - idxmap%state = psb_desc_bld_ - call psb_get_mpicomm(ictxt,idxmap%mpic) - - lc2 = int(1.5*nl) - allocate(idxmap%hash,idxmap%loc_to_glob(lc2),stat=info) - if (info /= 0) then - info = -2 - return - end if - - call psb_hash_init(nl,idxmap%hash,info) - if (info /= 0) then - write(0,*) 'from Hash_Init inside init_vlu',info - info = -3 - return - endif - - do i=1, nl - idxmap%loc_to_glob(i) = vlu(i) - end do - - call hash_bld_g2l_map(idxmap,info) - call idxmap%set_state(psb_desc_bld_) - -end subroutine hash_init_vlu - - - -subroutine hash_bld_g2l_map(idxmap,info) - use psb_penv_mod - use psb_error_mod - use psb_sort_mod - use psb_realloc_mod - implicit none - class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(out) :: info - ! To be implemented - integer(psb_ipk_) :: ictxt, iam, np, i, j, m, nl - integer(psb_ipk_) :: key, ih, nh, idx, nbits, hsize, hmask - character(len=20), parameter :: name='hash_map_init_vlu' - - info = 0 - ictxt = idxmap%get_ctxt() - - call psb_info(ictxt,iam,np) - if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:',ictxt - info = -1 - return - end if + allocate(vlu(nl), stat=info) + if (info /= 0) then + info = -1 + return + end if - nl = idxmap%get_lc() + j = 0 + do i=1, n + if (vg(i) == iam) then + j = j + 1 + vlu(j) = i + end if + end do + + + call hash_init_vlu(idxmap,ictxt,n,nl,vlu,info) - call psb_realloc(nl,2,idxmap%glb_lc,info) - nbits = psb_hash_bits - hsize = 2**nbits - do - if (hsize < 0) then - ! This should never happen for sane values - ! of psb_max_hash_bits. - write(psb_err_unit,*) & - & 'Error: hash size overflow ',hsize,nbits - info = -2 + end subroutine hash_init_vg + + + subroutine hash_init_vlu(idxmap,ictxt,ntot,nl,vlu,info) + use psb_penv_mod + use psb_error_mod + use psb_sort_mod + use psb_realloc_mod + implicit none + class(psb_hash_map), intent(inout) :: idxmap + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: vlu(:), nl, ntot + integer(psb_ipk_), intent(out) :: info + ! To be implemented + integer(psb_mpik_) :: iam, np + integer(psb_ipk_) :: i, j, lc2, nlu, m, nrt,int_err(5) + character(len=20), parameter :: name='hash_map_init_vlu' + + info = 0 + call psb_info(ictxt,iam,np) + if (np < 0) then + write(psb_err_unit,*) 'Invalid ictxt:',ictxt + info = -1 return end if - if (hsize > nl) exit - if (nbits >= psb_max_hash_bits) exit - nbits = nbits + 1 - hsize = hsize * 2 - end do - - hmask = hsize - 1 - idxmap%hashvsize = hsize - idxmap%hashvmask = hmask - - if (info == psb_success_) & - & call psb_realloc(hsize+1,idxmap%hashv,info,lb=0) - if (info /= psb_success_) then - ! !$ ch_err='psb_realloc' - ! !$ call psb_errpush(info,name,a_err=ch_err) - ! !$ goto 9999 - info = -4 - return - end if - - idxmap%hashv(:) = 0 - - do i=1, nl - key = idxmap%loc_to_glob(i) - ih = iand(key,hmask) - idxmap%hashv(ih) = idxmap%hashv(ih) + 1 - end do - - nh = idxmap%hashv(0) - idx = 1 - - do i=1, hsize - idxmap%hashv(i-1) = idx - idx = idx + nh - nh = idxmap%hashv(i) - end do - - do i=1, nl - key = idxmap%loc_to_glob(i) - ih = iand(key,hmask) - idx = idxmap%hashv(ih) - idxmap%glb_lc(idx,1) = key - idxmap%glb_lc(idx,2) = i - idxmap%hashv(ih) = idxmap%hashv(ih) + 1 - end do - - do i = hsize, 1, -1 - idxmap%hashv(i) = idxmap%hashv(i-1) - end do - - idxmap%hashv(0) = 1 - do i=0, hsize-1 - idx = idxmap%hashv(i) - nh = idxmap%hashv(i+1) - idxmap%hashv(i) - if (nh > 1) then - call psb_msort(idxmap%glb_lc(idx:idx+nh-1,1),& - & ix=idxmap%glb_lc(idx:idx+nh-1,2),& - & flag=psb_sort_keep_idx_) + + idxmap%global_rows = ntot + idxmap%global_cols = ntot + idxmap%local_rows = nl + idxmap%local_cols = nl + idxmap%ictxt = ictxt + idxmap%state = psb_desc_bld_ + call psb_get_mpicomm(ictxt,idxmap%mpic) + + lc2 = int(1.5*nl) + allocate(idxmap%hash,idxmap%loc_to_glob(lc2),stat=info) + if (info /= 0) then + info = -2 + return end if - end do -end subroutine hash_bld_g2l_map + call psb_hash_init(nl,idxmap%hash,info) + if (info /= 0) then + write(0,*) 'from Hash_Init inside init_vlu',info + info = -3 + return + endif + do i=1, nl + idxmap%loc_to_glob(i) = vlu(i) + end do -subroutine hash_asb(idxmap,info) - use psb_penv_mod - use psb_error_mod - use psb_realloc_mod - use psb_sort_mod - implicit none - class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(out) :: info + call hash_bld_g2l_map(idxmap,info) + call idxmap%set_state(psb_desc_bld_) - integer(psb_ipk_) :: nhal, ictxt, iam, np + end subroutine hash_init_vlu - info = 0 - ictxt = idxmap%get_ctxt() - call psb_info(ictxt,iam,np) - nhal = max(0,idxmap%local_cols-idxmap%local_rows) - call hash_bld_g2l_map(idxmap,info) - if (info /= 0) then - write(0,*) 'Error from bld_g2l_map', info - return - end if + subroutine hash_bld_g2l_map(idxmap,info) + use psb_penv_mod + use psb_error_mod + use psb_sort_mod + use psb_realloc_mod + implicit none + class(psb_hash_map), intent(inout) :: idxmap + integer(psb_ipk_), intent(out) :: info + ! To be implemented + integer(psb_mpik_) :: ictxt, iam, np + integer(psb_ipk_) :: i, j, m, nl + integer(psb_ipk_) :: key, ih, nh, idx, nbits, hsize, hmask + character(len=20), parameter :: name='hash_map_init_vlu' + + info = 0 + ictxt = idxmap%get_ctxt() + + call psb_info(ictxt,iam,np) + if (np < 0) then + write(psb_err_unit,*) 'Invalid ictxt:',ictxt + info = -1 + return + end if - call psb_free(idxmap%hash,info) - if (info == 0) deallocate(idxmap%hash,stat=info) - if (info /= 0) then - write(0,*) 'Error from hash free', info - return - end if - - call idxmap%set_state(psb_desc_asb_) - -end subroutine hash_asb - -function hash_get_fmt() result(res) - implicit none - character(len=5) :: res - res = 'HASH' -end function hash_get_fmt - - -subroutine hash_inner_cnvs1(x,hashmask,hashv,glb_lc,nrm) - - integer(psb_ipk_), intent(in) :: hashmask,hashv(0:),glb_lc(:,:) - integer(psb_ipk_), intent(inout) :: x - integer(psb_ipk_), intent(in) :: nrm - integer(psb_ipk_) :: ih, key, idx,nh,tmp,lb,ub,lm - ! - ! When a large descriptor is assembled the indices - ! are kept in a (hashed) list of ordered lists. - ! Thus we first hash the index, then we do a binary search on the - ! ordered sublist. The hashing is based on the low-order bits - ! for a width of psb_hash_bits - ! - - key = x - ih = iand(key,hashmask) - idx = hashv(ih) - nh = hashv(ih+1) - hashv(ih) - if (nh > 0) then - tmp = -1 - lb = idx - ub = idx+nh-1 + nl = idxmap%get_lc() + + call psb_realloc(nl,2,idxmap%glb_lc,info) + + nbits = psb_hash_bits + hsize = 2**nbits do - if (lb>ub) exit - lm = (lb+ub)/2 - if (key == glb_lc(lm,1)) then - tmp = lm - exit - else if (key nl) exit + if (nbits >= psb_max_hash_bits) exit + nbits = nbits + 1 + hsize = hsize * 2 end do - else - tmp = -1 - end if - if (tmp > 0) then - x = glb_lc(tmp,2) - if (x > nrm) then - x = -1 + + hmask = hsize - 1 + idxmap%hashvsize = hsize + idxmap%hashvmask = hmask + + if (info == psb_success_) & + & call psb_realloc(hsize+1,idxmap%hashv,info,lb=0_psb_ipk_) + if (info /= psb_success_) then + ! !$ ch_err='psb_realloc' + ! !$ call psb_errpush(info,name,a_err=ch_err) + ! !$ goto 9999 + info = -4 + return end if - else - x = tmp - end if -end subroutine hash_inner_cnvs1 - -subroutine hash_inner_cnvs2(x,y,hashmask,hashv,glb_lc,nrm) - integer(psb_ipk_), intent(in) :: hashmask,hashv(0:),glb_lc(:,:) - integer(psb_ipk_), intent(in) :: x - integer(psb_ipk_), intent(out) :: y - integer(psb_ipk_), intent(in) :: nrm - integer(psb_ipk_) :: ih, key, idx,nh,tmp,lb,ub,lm - ! - ! When a large descriptor is assembled the indices - ! are kept in a (hashed) list of ordered lists. - ! Thus we first hash the index, then we do a binary search on the - ! ordered sublist. The hashing is based on the low-order bits - ! for a width of psb_hash_bits - ! - - key = x - ih = iand(key,hashmask) - idx = hashv(ih) - nh = hashv(ih+1) - hashv(ih) - if (nh > 0) then - tmp = -1 - lb = idx - ub = idx+nh-1 - do - if (lb>ub) exit - lm = (lb+ub)/2 - if (key == glb_lc(lm,1)) then - tmp = lm - exit - else if (key 1) then + call psb_msort(idxmap%glb_lc(idx:idx+nh-1,1),& + & ix=idxmap%glb_lc(idx:idx+nh-1,2),& + & flag=psb_sort_keep_idx_) end if end do - else - tmp = -1 - end if - if (tmp > 0) then - y = glb_lc(tmp,2) - if (y > nrm) then - y = -1 + + end subroutine hash_bld_g2l_map + + + subroutine hash_asb(idxmap,info) + use psb_penv_mod + use psb_error_mod + use psb_realloc_mod + use psb_sort_mod + implicit none + class(psb_hash_map), intent(inout) :: idxmap + integer(psb_ipk_), intent(out) :: info + + integer(psb_mpik_) :: ictxt, iam, np + integer(psb_ipk_) :: nhal + + info = 0 + ictxt = idxmap%get_ctxt() + call psb_info(ictxt,iam,np) + + nhal = max(0,idxmap%local_cols-idxmap%local_rows) + + call hash_bld_g2l_map(idxmap,info) + if (info /= 0) then + write(0,*) 'Error from bld_g2l_map', info + return end if - else - y = tmp - end if -end subroutine hash_inner_cnvs2 - - -subroutine hash_inner_cnv1(n,x,hashmask,hashv,glb_lc,mask,nrm) - integer(psb_ipk_), intent(in) :: n,hashmask,hashv(0:),glb_lc(:,:) - logical, intent(in), optional :: mask(:) - integer(psb_ipk_), intent(in), optional :: nrm - integer(psb_ipk_), intent(inout) :: x(:) - - integer(psb_ipk_) :: i, ih, key, idx,nh,tmp,lb,ub,lm - ! - ! When a large descriptor is assembled the indices - ! are kept in a (hashed) list of ordered lists. - ! Thus we first hash the index, then we do a binary search on the - ! ordered sublist. The hashing is based on the low-order bits - ! for a width of psb_hash_bits - ! - if (present(mask)) then - do i=1, n - if (mask(i)) then + + call psb_free(idxmap%hash,info) + if (info == 0) deallocate(idxmap%hash,stat=info) + if (info /= 0) then + write(0,*) 'Error from hash free', info + return + end if + + call idxmap%set_state(psb_desc_asb_) + + end subroutine hash_asb + + function hash_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HASH' + end function hash_get_fmt + + + subroutine hash_inner_cnvs1(x,hashmask,hashv,glb_lc,nrm) + + integer(psb_ipk_), intent(in) :: hashmask,hashv(0:),glb_lc(:,:) + integer(psb_ipk_), intent(inout) :: x + integer(psb_ipk_), intent(in) :: nrm + integer(psb_ipk_) :: ih, key, idx,nh,tmp,lb,ub,lm + ! + ! When a large descriptor is assembled the indices + ! are kept in a (hashed) list of ordered lists. + ! Thus we first hash the index, then we do a binary search on the + ! ordered sublist. The hashing is based on the low-order bits + ! for a width of psb_hash_bits + ! + + key = x + ih = iand(key,hashmask) + idx = hashv(ih) + nh = hashv(ih+1) - hashv(ih) + if (nh > 0) then + tmp = -1 + lb = idx + ub = idx+nh-1 + do + if (lb>ub) exit + lm = (lb+ub)/2 + if (key == glb_lc(lm,1)) then + tmp = lm + exit + else if (key 0) then + x = glb_lc(tmp,2) + if (x > nrm) then + x = -1 + end if + else + x = tmp + end if + end subroutine hash_inner_cnvs1 + + subroutine hash_inner_cnvs2(x,y,hashmask,hashv,glb_lc,nrm) + integer(psb_ipk_), intent(in) :: hashmask,hashv(0:),glb_lc(:,:) + integer(psb_ipk_), intent(in) :: x + integer(psb_ipk_), intent(out) :: y + integer(psb_ipk_), intent(in) :: nrm + integer(psb_ipk_) :: ih, key, idx,nh,tmp,lb,ub,lm + ! + ! When a large descriptor is assembled the indices + ! are kept in a (hashed) list of ordered lists. + ! Thus we first hash the index, then we do a binary search on the + ! ordered sublist. The hashing is based on the low-order bits + ! for a width of psb_hash_bits + ! + + key = x + ih = iand(key,hashmask) + idx = hashv(ih) + nh = hashv(ih+1) - hashv(ih) + if (nh > 0) then + tmp = -1 + lb = idx + ub = idx+nh-1 + do + if (lb>ub) exit + lm = (lb+ub)/2 + if (key == glb_lc(lm,1)) then + tmp = lm + exit + else if (key 0) then + y = glb_lc(tmp,2) + if (y > nrm) then + y = -1 + end if + else + y = tmp + end if + end subroutine hash_inner_cnvs2 + + + subroutine hash_inner_cnv1(n,x,hashmask,hashv,glb_lc,mask,nrm) + integer(psb_ipk_), intent(in) :: n,hashmask,hashv(0:),glb_lc(:,:) + logical, intent(in), optional :: mask(:) + integer(psb_ipk_), intent(in), optional :: nrm + integer(psb_ipk_), intent(inout) :: x(:) + + integer(psb_ipk_) :: i, ih, key, idx,nh,tmp,lb,ub,lm + ! + ! When a large descriptor is assembled the indices + ! are kept in a (hashed) list of ordered lists. + ! Thus we first hash the index, then we do a binary search on the + ! ordered sublist. The hashing is based on the low-order bits + ! for a width of psb_hash_bits + ! + if (present(mask)) then + do i=1, n + if (mask(i)) then + key = x(i) + ih = iand(key,hashmask) + idx = hashv(ih) + nh = hashv(ih+1) - hashv(ih) + if (nh > 0) then + tmp = -1 + lb = idx + ub = idx+nh-1 + do + if (lb>ub) exit + lm = (lb+ub)/2 + if (key == glb_lc(lm,1)) then + tmp = lm + exit + else if (key 0) then + x(i) = glb_lc(tmp,2) + if (present(nrm)) then + if (x(i) > nrm) then + x(i) = -1 + end if + end if + else + x(i) = tmp + end if + end if + end do + else + do i=1, n key = x(i) ih = iand(key,hashmask) idx = hashv(ih) @@ -1096,65 +1144,70 @@ subroutine hash_inner_cnv1(n,x,hashmask,hashv,glb_lc,mask,nrm) else x(i) = tmp end if - end if - end do - else - do i=1, n - key = x(i) - ih = iand(key,hashmask) - idx = hashv(ih) - nh = hashv(ih+1) - hashv(ih) - if (nh > 0) then - tmp = -1 - lb = idx - ub = idx+nh-1 - do - if (lb>ub) exit - lm = (lb+ub)/2 - if (key == glb_lc(lm,1)) then - tmp = lm - exit - else if (key ubound(hashv,1) ) then + write(psb_err_unit,*) ' In inner cnv: ',ih,ubound(hashv) end if - end do - else - tmp = -1 - end if - if (tmp > 0) then - x(i) = glb_lc(tmp,2) - if (present(nrm)) then - if (x(i) > nrm) then - x(i) = -1 + idx = hashv(ih) + nh = hashv(ih+1) - hashv(ih) + if (nh > 0) then + tmp = -1 + lb = idx + ub = idx+nh-1 + do + if (lb>ub) exit + lm = (lb+ub)/2 + if (key == glb_lc(lm,1)) then + tmp = lm + exit + else if (key 0) then + y(i) = glb_lc(tmp,2) + if (present(nrm)) then + if (y(i) > nrm) then + y(i) = -1 + end if + end if + else + y(i) = tmp end if end if - else - x(i) = tmp - end if - end do - end if -end subroutine hash_inner_cnv1 - -subroutine hash_inner_cnv2(n,x,y,hashmask,hashv,glb_lc,mask,nrm) - integer(psb_ipk_), intent(in) :: n, hashmask,hashv(0:),glb_lc(:,:) - logical, intent(in), optional :: mask(:) - integer(psb_ipk_), intent(in), optional :: nrm - integer(psb_ipk_), intent(in) :: x(:) - integer(psb_ipk_), intent(out) :: y(:) - - integer(psb_ipk_) :: i, ih, key, idx,nh,tmp,lb,ub,lm - ! - ! When a large descriptor is assembled the indices - ! are kept in a (hashed) list of ordered lists. - ! Thus we first hash the index, then we do a binary search on the - ! ordered sublist. The hashing is based on the low-order bits - ! for a width of psb_hash_bits - ! - if (present(mask)) then - do i=1, n - if (mask(i)) then + end do + + else + + do i=1, n key = x(i) ih = iand(key,hashmask) if (ih > ubound(hashv,1) ) then @@ -1191,51 +1244,9 @@ subroutine hash_inner_cnv2(n,x,y,hashmask,hashv,glb_lc,mask,nrm) else y(i) = tmp end if - end if - end do - - else - - do i=1, n - key = x(i) - ih = iand(key,hashmask) - if (ih > ubound(hashv,1) ) then - write(psb_err_unit,*) ' In inner cnv: ',ih,ubound(hashv) - end if - idx = hashv(ih) - nh = hashv(ih+1) - hashv(ih) - if (nh > 0) then - tmp = -1 - lb = idx - ub = idx+nh-1 - do - if (lb>ub) exit - lm = (lb+ub)/2 - if (key == glb_lc(lm,1)) then - tmp = lm - exit - else if (key 0) then - y(i) = glb_lc(tmp,2) - if (present(nrm)) then - if (y(i) > nrm) then - y(i) = -1 - end if - end if - else - y(i) = tmp - end if - end do - end if -end subroutine hash_inner_cnv2 + end do + end if + end subroutine hash_inner_cnv2 subroutine hash_clone(idxmap,outmap,info) diff --git a/base/modules/psb_hash_mod.f90 b/base/modules/psb_hash_mod.f90 index 44e263e5..cb9d5b9d 100644 --- a/base/modules/psb_hash_mod.f90 +++ b/base/modules/psb_hash_mod.f90 @@ -130,7 +130,8 @@ contains subroutine HashFree(hashin,info) use psb_realloc_mod type(psb_hash_type) :: hashin - + integer(psb_ipk_) :: info + info = psb_success_ if (allocated(hashin%table)) then deallocate(hashin%table,stat=info) diff --git a/base/modules/psb_indx_map_mod.f90 b/base/modules/psb_indx_map_mod.f90 index f6c09c65..f4865929 100644 --- a/base/modules/psb_indx_map_mod.f90 +++ b/base/modules/psb_indx_map_mod.f90 @@ -89,8 +89,8 @@ module psb_indx_map_mod type :: psb_indx_map integer(psb_ipk_) :: state = psb_desc_null_ - integer(psb_ipk_) :: ictxt = -1 - integer(psb_ipk_) :: mpic = -1 + integer(psb_mpik_) :: ictxt = -1 + integer(psb_mpik_) :: mpic = -1 integer(psb_ipk_) :: global_rows = -1 integer(psb_ipk_) :: global_cols = -1 integer(psb_ipk_) :: local_rows = -1 @@ -241,7 +241,7 @@ contains function base_get_ctxt(idxmap) result(val) implicit none class(psb_indx_map), intent(in) :: idxmap - integer(psb_ipk_) :: val + integer(psb_mpik_) :: val val = idxmap%ictxt @@ -251,7 +251,7 @@ contains function base_get_mpic(idxmap) result(val) implicit none class(psb_indx_map), intent(in) :: idxmap - integer(psb_ipk_) :: val + integer(psb_mpik_) :: val val = idxmap%mpic @@ -269,7 +269,7 @@ contains subroutine base_set_ctxt(idxmap,val) implicit none class(psb_indx_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: val + integer(psb_mpik_), intent(in) :: val idxmap%ictxt = val end subroutine base_set_ctxt @@ -309,7 +309,7 @@ contains subroutine base_set_mpic(idxmap,val) implicit none class(psb_indx_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: val + integer(psb_mpik_), intent(in) :: val idxmap%mpic = val end subroutine base_set_mpic @@ -773,7 +773,8 @@ contains use psb_error_mod implicit none class(psb_indx_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt, vl(:) + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act character(len=20) :: name='base_init_vl' diff --git a/base/modules/psb_list_map_mod.f90 b/base/modules/psb_list_map_mod.f90 index 19fdf2a4..8074af8d 100644 --- a/base/modules/psb_list_map_mod.f90 +++ b/base/modules/psb_list_map_mod.f90 @@ -80,6 +80,8 @@ module psb_list_map_mod & list_g2lv2, list_g2ls1_ins, list_g2ls2_ins,& & list_g2lv1_ins, list_g2lv2_ins, list_row_extendable + integer(psb_ipk_), private :: laddsz=500 + contains function list_row_extendable() result(val) @@ -417,7 +419,7 @@ contains ix = idxmap%glob_to_loc(idx(i)) if (ix < 0) then ix = idxmap%local_cols + 1 - call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=500) + call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz) if (info /= 0) then info = -4 return @@ -440,7 +442,7 @@ contains ix = idxmap%glob_to_loc(idx(i)) if (ix < 0) then ix = idxmap%local_cols + 1 - call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=500) + call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz) if (info /= 0) then info = -4 return @@ -544,10 +546,12 @@ contains use psb_error_mod implicit none class(psb_list_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt, vl(:) + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_ipk_) :: iam, np, i, ix, nl, n, nrt + integer(psb_ipk_) :: i, ix, nl, n, nrt + integer(psb_mpik_) :: iam, np info = 0 call psb_info(ictxt,iam,np) @@ -610,7 +614,8 @@ contains class(psb_list_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: nhal, ictxt, iam, np + integer(psb_ipk_) :: nhal + integer(psb_mpik_) :: ictxt, iam, np info = 0 ictxt = idxmap%get_ctxt() diff --git a/base/modules/psb_repl_map_mod.f90 b/base/modules/psb_repl_map_mod.f90 index 08d0d323..7a646fd0 100644 --- a/base/modules/psb_repl_map_mod.f90 +++ b/base/modules/psb_repl_map_mod.f90 @@ -459,7 +459,8 @@ contains integer(psb_ipk_), allocatable, intent(out) :: iprc(:) class(psb_repl_map), intent(in) :: idxmap integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, iam, np, nv + integer(psb_ipk_) :: nv + integer(psb_mpik_) :: ictxt, iam, np ictxt = idxmap%get_ctxt() call psb_info(ictxt,iam,np) @@ -480,10 +481,11 @@ contains use psb_error_mod implicit none class(psb_repl_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt, nl + integer(psb_ipk_), intent(in) :: nl + integer(psb_mpik_), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_ipk_) :: iam, np + integer(psb_mpik_) :: iam, np info = 0 call psb_info(ictxt,iam,np) @@ -513,7 +515,7 @@ contains class(psb_repl_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, iam, np + integer(psb_mpik_) :: ictxt, iam, np info = 0 ictxt = idxmap%get_ctxt() diff --git a/base/modules/psb_s_linmap_mod.f90 b/base/modules/psb_s_linmap_mod.f90 index 577c3fc6..bbb420b0 100644 --- a/base/modules/psb_s_linmap_mod.f90 +++ b/base/modules/psb_s_linmap_mod.f90 @@ -132,8 +132,6 @@ module psb_s_linmap_mod - - contains function s_map_sizeof(map) result(val) diff --git a/base/modules/psb_z_linmap_mod.f90 b/base/modules/psb_z_linmap_mod.f90 index 234958cf..1d5b15ce 100644 --- a/base/modules/psb_z_linmap_mod.f90 +++ b/base/modules/psb_z_linmap_mod.f90 @@ -131,9 +131,6 @@ module psb_z_linmap_mod private :: z_map_sizeof, z_is_asb, z_free - - - contains function z_map_sizeof(map) result(val) diff --git a/base/modules/psi_bcast_mod.F90 b/base/modules/psi_bcast_mod.F90 index e3ad2b63..a1dccb18 100644 --- a/base/modules/psi_bcast_mod.F90 +++ b/base/modules/psi_bcast_mod.F90 @@ -29,11 +29,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt integer(psb_ipk_), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -55,11 +55,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt integer(psb_ipk_), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then root_ = root @@ -80,11 +80,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt integer(psb_ipk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -107,11 +107,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -134,11 +134,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -161,11 +161,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -189,11 +189,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -216,11 +216,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -242,11 +242,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -268,11 +268,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -294,11 +294,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -320,11 +320,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -346,11 +346,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -372,11 +372,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -398,11 +398,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_, info + integer(psb_mpik_) :: iam, np, root_, info #if !defined(SERIAL_MPI) if (present(root)) then @@ -425,11 +425,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt character(len=*), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root,length + integer(psb_mpik_), intent(in), optional :: root,length - integer(psb_ipk_) :: iam, np, root_,length_,info + integer(psb_mpik_) :: iam, np, root_,length_,info #if !defined(SERIAL_MPI) if (present(root)) then @@ -458,11 +458,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt character(len=*), intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_,length_,info, size_ + integer(psb_mpik_) :: iam, np, root_,length_,info, size_ #if !defined(SERIAL_MPI) if (present(root)) then @@ -488,11 +488,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt logical, intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_,info + integer(psb_mpik_) :: iam, np, root_,info #if !defined(SERIAL_MPI) if (present(root)) then @@ -516,11 +516,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: ictxt logical, intent(inout) :: dat(:) - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpik_), intent(in), optional :: root - integer(psb_ipk_) :: iam, np, root_,info + integer(psb_mpik_) :: iam, np, root_,info #if !defined(SERIAL_MPI) if (present(root)) then diff --git a/base/modules/psi_i_mod.f90 b/base/modules/psi_i_mod.f90 index 827deb16..0f4c4733 100644 --- a/base/modules/psi_i_mod.f90 +++ b/base/modules/psi_i_mod.f90 @@ -30,7 +30,7 @@ !!$ !!$ module psi_i_mod - use psb_descriptor_type, only : psb_desc_type, psb_ipk_ + use psb_descriptor_type, only : psb_desc_type, psb_ipk_, psb_mpik_ interface subroutine psi_compute_size(desc_data,& @@ -100,9 +100,10 @@ module psi_i_mod interface subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& & length_dl,np,dl_lda,mode,info) - import :: psb_desc_type, psb_ipk_ + import :: psb_desc_type, psb_ipk_, psb_mpik_ logical :: is_bld, is_upd - integer(psb_ipk_) :: ictxt,np,dl_lda,mode, info + integer(psb_mpik_) :: ictxt + integer(psb_ipk_) :: np,dl_lda,mode, info integer(psb_ipk_) :: desc_str(*),dep_list(dl_lda,0:np),length_dl(0:np) end subroutine psi_extract_dep_list end interface