diff --git a/base/modules/psb_hash_map_mod.f90 b/base/modules/psb_hash_map_mod.f90 index 25607717..9db3b330 100644 --- a/base/modules/psb_hash_map_mod.f90 +++ b/base/modules/psb_hash_map_mod.f90 @@ -73,6 +73,7 @@ module psb_hash_map_mod procedure, pass(idxmap) :: asb => hash_asb procedure, pass(idxmap) :: free => hash_free procedure, pass(idxmap) :: clone => hash_clone + procedure, pass(idxmap) :: reinit => hash_reinit procedure, nopass :: get_fmt => hash_get_fmt procedure, nopass :: row_extendable => hash_row_extendable @@ -1452,5 +1453,55 @@ contains end subroutine hash_cpy + + subroutine hash_reinit(idxmap,info) + use psb_penv_mod + use psb_error_mod + use psb_realloc_mod + implicit none + class(psb_hash_map), intent(inout) :: idxmap + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act, nr,nc,k, nl, ictxt, ntot + integer(psb_ipk_), allocatable :: idx(:),lidx(:) + character(len=20) :: name='hash_reinit' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_get_erraction(err_act) + ictxt = idxmap%get_ctxt() + nr = idxmap%get_lr() + nc = idxmap%get_lc() + ntot = idxmap%get_gr() + if (nc>nr) then + lidx = (/(k,k=1,nc)/) + idx = (/(k,k=1,nc)/) + call idxmap%l2gip(idx,info) + end if + if (info /= 0) & + & write(0,*) 'From l2gip',info + + call idxmap%free() + call hash_init_vlu(idxmap,ictxt,ntot,nr,idx(1:nr),info) + if (nc>nr) then + call idxmap%g2lip_ins(idx(nr+1:nc),info,lidx=lidx(nr+1:nc)) + end if + + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name) + goto 9999 + end if + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act /= psb_act_ret_) then + call psb_error() + end if + return + end subroutine hash_reinit + end module psb_hash_map_mod diff --git a/base/modules/psb_repl_map_mod.f90 b/base/modules/psb_repl_map_mod.f90 index fad6555a..71e985f7 100644 --- a/base/modules/psb_repl_map_mod.f90 +++ b/base/modules/psb_repl_map_mod.f90 @@ -196,11 +196,49 @@ contains logical, intent(in), optional :: mask(:) logical, intent(in), optional :: owned integer(psb_ipk_) :: is, im + integer(psb_ipk_) :: i + logical :: owned_ + info = 0 is = size(idxin) im = min(is,size(idxout)) - idxout(1:im) = idxin(1:im) - call idxmap%l2gip(idxout(1:im),info,mask,owned) + + if (present(mask)) then + if (size(mask) < im) 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, im + if (mask(i)) then + if ((1<=idxin(i)).and.(idxin(i) <= idxmap%local_rows)) then + idxout(i) = idxin(i) + else + idxout(i) = -1 + end if + end if + end do + + else if (.not.present(mask)) then + + do i=1, im + if ((1<=idxin(i)).and.(idxin(i) <= idxmap%local_rows)) then + idxout(i) = idxin(i) + else + idxout(i) = -1 + end if + end do + + end if + if (is > im) info = -3 end subroutine repl_l2gv2 @@ -331,12 +369,79 @@ contains logical, intent(in), optional :: mask(:) logical, intent(in), optional :: owned - integer(psb_ipk_) :: is, im + integer(psb_ipk_) :: is, im,i + logical :: owned_ + + info = 0 is = size(idxin) im = min(is,size(idxout)) - idxout(1:im) = idxin(1:im) - call idxmap%g2lip(idxout(1:im),info,mask,owned) + + if (present(mask)) then + if (size(mask) < im) then + info = -1 + return + end if + end if + if (present(owned)) then + owned_ = owned + else + owned_ = .false. + end if + + + if (present(mask)) then + + if (idxmap%is_asb()) then + do i=1, is + if (mask(i)) then + if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then + idxout(i) = idxin(i) + else + idxout(i) = -1 + end if + end if + end do + else if (idxmap%is_valid()) then + do i=1,is + if (mask(i)) then + if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then + idxout(i) = idxin(i) + else + idxout(i) = -1 + end if + end if + end do + else + idxout(1:is) = -1 + info = -1 + end if + + else if (.not.present(mask)) then + + if (idxmap%is_asb()) then + do i=1, is + if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then + idxout(i) = idxin(i) + else + idxout(i) = -1 + end if + end do + else if (idxmap%is_valid()) then + do i=1,is + if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then + idxout(i) = idxin(i) + else + idxout(i) = -1 + end if + end do + else + idxout(1:is) = -1 + info = -1 + end if + + end if + if (is > im) info = -3 end subroutine repl_g2lv2 @@ -480,12 +585,82 @@ contains logical, intent(in), optional :: mask(:) integer(psb_ipk_), intent(in), optional :: lidx(:) - integer(psb_ipk_) :: is, im + integer(psb_ipk_) :: is, im, i + + info = 0 is = size(idxin) im = min(is,size(idxout)) - idxout(1:im) = idxin(1:im) - call idxmap%g2lip_ins(idxout(1:im),info,mask=mask,lidx=lidx) + + if (present(mask)) then + if (size(mask) < im) then + info = -1 + return + end if + end if + if (present(lidx)) then + if (size(lidx) < im) then + info = -1 + return + end if + end if + + + if (idxmap%is_asb()) then + ! State is wrong for this one ! + idxout = -1 + info = -1 + + else if (idxmap%is_valid()) then + if (present(lidx)) then + if (present(mask)) then + do i=1, is + if (mask(i)) then + if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then + idxout(i) = idxin(i) + else + idxout(i) = -1 + end if + end if + end do + + else if (.not.present(mask)) then + + do i=1, is + if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then + idxout(i) = idxin(i) + else + idxout(i) = -1 + end if + end do + end if + else if (.not.present(lidx)) then + if (present(mask)) then + do i=1, is + if (mask(i)) then + if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then + idxout(i) = idxin(i) + else + idxout(i) = -1 + end if + end if + end do + + else if (.not.present(mask)) then + do i=1, is + if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then + idxout(i) = idxin(i) + else + idxout(i) = -1 + end if + end do + end if + end if + else + idxout = -1 + info = -1 + end if + if (is > im) info = -3 end subroutine repl_g2lv2_ins