|
|
@ -659,6 +659,226 @@ contains
|
|
|
|
|
|
|
|
|
|
|
|
!$ use_openmp = .true.
|
|
|
|
!$ use_openmp = .true.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (.true.) then
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
|
|
|
|
name = 'hash_g2l_ins'
|
|
|
|
|
|
|
|
call psb_erractionsave(err_act)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
ctxt = idxmap%get_ctxt()
|
|
|
|
|
|
|
|
call psb_info(ctxt, me, np)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
is = size(idx)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (present(mask)) then
|
|
|
|
|
|
|
|
if (size(mask) < size(idx)) then
|
|
|
|
|
|
|
|
info = -1
|
|
|
|
|
|
|
|
return
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
if (present(lidx)) then
|
|
|
|
|
|
|
|
if (size(lidx) < 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(lidx)) 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
|
|
|
|
|
|
|
|
call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
|
|
|
|
|
|
|
|
& idxmap%hashv,idxmap%glb_lc,ncol)
|
|
|
|
|
|
|
|
if (lip < 0) then
|
|
|
|
|
|
|
|
tlip = lip
|
|
|
|
|
|
|
|
nxt = lidx(i)
|
|
|
|
|
|
|
|
if (nxt <= nrow) then
|
|
|
|
|
|
|
|
idx(i) = -1
|
|
|
|
|
|
|
|
cycle
|
|
|
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
|
|
|
|
|
|
|
|
if (info >=0) then
|
|
|
|
|
|
|
|
if (nxt == tlip) then
|
|
|
|
|
|
|
|
ncol = max(ncol,nxt)
|
|
|
|
|
|
|
|
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
|
|
|
|
|
|
|
|
& pad=-1_psb_lpk_,addsz=laddsz)
|
|
|
|
|
|
|
|
if (info /= psb_success_) then
|
|
|
|
|
|
|
|
call psb_errpush(psb_err_from_subroutine_ai_,name,&
|
|
|
|
|
|
|
|
&a_err='psb_ensure_size',i_err=(/info/))
|
|
|
|
|
|
|
|
goto 9999
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
idxmap%loc_to_glob(nxt) = ip
|
|
|
|
|
|
|
|
call idxmap%set_lc(ncol)
|
|
|
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
call psb_errpush(psb_err_from_subroutine_ai_,name,&
|
|
|
|
|
|
|
|
& a_err='SearchInsKeyVal',i_err=(/info/))
|
|
|
|
|
|
|
|
goto 9999
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
idx(i) = lip
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
idx(i) = -1
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
else if (.not.present(mask)) then
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
do i = 1, is
|
|
|
|
|
|
|
|
ncol = idxmap%get_lc()
|
|
|
|
|
|
|
|
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,ncol)
|
|
|
|
|
|
|
|
if (lip < 0) then
|
|
|
|
|
|
|
|
nxt = lidx(i)
|
|
|
|
|
|
|
|
if (nxt <= nrow) then
|
|
|
|
|
|
|
|
idx(i) = -1
|
|
|
|
|
|
|
|
cycle
|
|
|
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
|
|
|
|
|
|
|
|
lip = tlip
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (info >=0) then
|
|
|
|
|
|
|
|
if (nxt == lip) then
|
|
|
|
|
|
|
|
ncol = max(nxt,ncol)
|
|
|
|
|
|
|
|
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-1_psb_lpk_,addsz=laddsz)
|
|
|
|
|
|
|
|
if (info /= psb_success_) then
|
|
|
|
|
|
|
|
info=1
|
|
|
|
|
|
|
|
call psb_errpush(psb_err_from_subroutine_ai_,name,&
|
|
|
|
|
|
|
|
&a_err='psb_ensure_size',i_err=(/info/))
|
|
|
|
|
|
|
|
goto 9999
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
idxmap%loc_to_glob(nxt) = ip
|
|
|
|
|
|
|
|
call idxmap%set_lc(ncol)
|
|
|
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
call psb_errpush(psb_err_from_subroutine_ai_,name,&
|
|
|
|
|
|
|
|
& a_err='SearchInsKeyVal',i_err=(/info/))
|
|
|
|
|
|
|
|
goto 9999
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
idx(i) = lip
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
else if (.not.present(lidx)) 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) then
|
|
|
|
|
|
|
|
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
|
|
|
|
|
|
|
|
lip = tlip
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (info >=0) then
|
|
|
|
|
|
|
|
if (nxt == lip) then
|
|
|
|
|
|
|
|
ncol = nxt
|
|
|
|
|
|
|
|
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
|
|
|
|
|
|
|
|
& pad=-1_psb_lpk_,addsz=laddsz)
|
|
|
|
|
|
|
|
if (info /= psb_success_) then
|
|
|
|
|
|
|
|
info=1
|
|
|
|
|
|
|
|
call psb_errpush(psb_err_from_subroutine_ai_,name,&
|
|
|
|
|
|
|
|
& a_err='psb_ensure_size',i_err=(/info/))
|
|
|
|
|
|
|
|
goto 9999
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
idxmap%loc_to_glob(nxt) = ip
|
|
|
|
|
|
|
|
call idxmap%set_lc(ncol)
|
|
|
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
call psb_errpush(psb_err_from_subroutine_ai_,name,&
|
|
|
|
|
|
|
|
& a_err='SearchInsKeyVal',i_err=(/info/))
|
|
|
|
|
|
|
|
goto 9999
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
idx(i) = lip
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
idx(i) = -1
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
else if (.not.present(mask)) then
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
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) then
|
|
|
|
|
|
|
|
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
|
|
|
|
|
|
|
|
lip = tlip
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (info >=0) then
|
|
|
|
|
|
|
|
if (nxt == lip) then
|
|
|
|
|
|
|
|
ncol = nxt
|
|
|
|
|
|
|
|
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
|
|
|
|
|
|
|
|
& pad=-1_psb_lpk_,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_
|
|
|
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
! Wrong state
|
|
|
|
|
|
|
|
idx = -1
|
|
|
|
|
|
|
|
info = -1
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
info = psb_success_
|
|
|
|
name = 'hash_g2l_ins'
|
|
|
|
name = 'hash_g2l_ins'
|
|
|
|
call psb_erractionsave(err_act)
|
|
|
|
call psb_erractionsave(err_act)
|
|
|
@ -983,6 +1203,8 @@ contains
|
|
|
|
!$OMP reduction(.AND.:isLoopValid)
|
|
|
|
!$OMP reduction(.AND.:isLoopValid)
|
|
|
|
do i = 1, is
|
|
|
|
do i = 1, is
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
ncol = idxmap%get_lc()
|
|
|
|
|
|
|
|
info = 0
|
|
|
|
if (mask(i)) then
|
|
|
|
if (mask(i)) then
|
|
|
|
ip = idx(i)
|
|
|
|
ip = idx(i)
|
|
|
|
|
|
|
|
|
|
|
@ -991,6 +1213,7 @@ contains
|
|
|
|
cycle
|
|
|
|
cycle
|
|
|
|
endif
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
nxt = ncol + 1
|
|
|
|
! At first, we check the index presence in 'idxmap'. Usually
|
|
|
|
! At first, we check the index presence in 'idxmap'. Usually
|
|
|
|
! the index is found. If it is not found, we repeat the checking,
|
|
|
|
! the index is found. If it is not found, we repeat the checking,
|
|
|
|
! but inside a critical region.
|
|
|
|
! but inside a critical region.
|
|
|
@ -1252,7 +1475,7 @@ contains
|
|
|
|
idx = -1
|
|
|
|
idx = -1
|
|
|
|
info = -1
|
|
|
|
info = -1
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
|
|
|
|
end if
|
|
|
|
call psb_erractionrestore(err_act)
|
|
|
|
call psb_erractionrestore(err_act)
|
|
|
|
return
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
|
|