fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Finish dual OMP/notOMP g2lv1_ins

Browse Source
master
sfilippone 1 year ago
parent 08c1ab0cd1
commit 3aa748b0e3
1 changed files with 355 additions and 366 deletions
Show Stats Download Patch File Download Diff File

721
base/modules/desc/psb_hash_map_mod.F90
Unescape Escape View File

@ -652,7 +652,7 @@ contains
integer(psb_ipk_) :: me, np integer(psb_ipk_) :: me, np
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
logical, allocatable :: mask_(:) logical, allocatable :: mask_(:)
logical :: use_openmp = .true. !!$ logical :: use_openmp = .true.
#ifdef OPENMP #ifdef OPENMP
integer(kind = OMP_lock_kind) :: ins_lck integer(kind = OMP_lock_kind) :: ins_lck
#endif #endif
@ -683,119 +683,32 @@ contains
mglob = idxmap%get_gr() mglob = idxmap%get_gr()
nrow = idxmap%get_lr() nrow = idxmap%get_lr()
!write(0,*) me,name,' before loop ',psb_errstatus_fatal() !write(0,*) me,name,' before loop ',psb_errstatus_fatal()
if (use_openmp) then
#ifdef OPENMP #ifdef OPENMP
!call OMP_init_lock(ins_lck) !call OMP_init_lock(ins_lck)
if (idxmap%is_bld()) then if (idxmap%is_bld()) then
isLoopValid = .true. isLoopValid = .true.
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
if (present(mask)) then if (present(mask)) then
mask_ = mask mask_ = mask
else else
allocate(mask_(size(idx))) allocate(mask_(size(idx)))
mask_ = .true. mask_ = .true.
end if end if
if (present(lidx)) then
if (present(mask)) then
!$omp critical(hash_g2l_ins)
! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) &
! $ OMP shared(name,me,is,idx,ins_lck,mask,mglob,idxmap,ncol,nrow,laddsz,lidx) &
! $ OMP private(i,ip,lip,tlip,nxt,info) &
! $ OMP reduction(.AND.:isLoopValid)
do i = 1, is
info = 0
if (.not. isLoopValid) cycle
if (mask(i)) then
ip = idx(i)
if ((ip < 1 ).or.(ip>mglob)) then
idx(i) = -1
cycle
endif
!call OMP_set_lock(ins_lck)
ncol = idxmap%get_lc()
!call OMP_unset_lock(ins_lck)
! At first, we check the index presence in 'idxmap'. Usually
! the index is found. If it is not found, we repeat the checking,
! but inside a critical region.
call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol)
if (lip < 0) then
!call OMP_set_lock(ins_lck)
! We check again if the index is already in 'idxmap', this
! time inside a critical region (we assume that the index
! is often already existing).
ncol = idxmap%get_lc()
nxt = lidx(i)
call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol)
if (lip > 0) then
idx(i) = lip
else if (lip < 0) then
! Index not found
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
if (info >= 0) then
! 'nxt' is not equal to 'tlip' when the key is already inside
! the hash map. In that case 'tlip' is the value corresponding
! to the existing mapping.
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
!write(0,*) 'Error spot 1'
call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false.
idx(i) = -1
else
idx(i) = lip
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(ncol)
end if
end if
else
idx(i) = -1
end if
!call OMP_unset_lock(ins_lck)
end if
else
idx(i) = lip
end if
else
idx(i) = -1
end if
end do
! $ OMP END PARALLEL DO
!$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) then if (present(lidx)) then
goto 9999 if (present(mask)) then
end if !$omp critical(hash_g2l_ins)
else
!$omp critical(hash_g2l_ins)
! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) & ! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) &
! $ OMP shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz,lidx) & ! $ OMP shared(name,me,is,idx,ins_lck,mask,mglob,idxmap,ncol,nrow,laddsz,lidx) &
! $ OMP private(i,ip,lip,tlip,nxt,info) & ! $ OMP private(i,ip,lip,tlip,nxt,info) &
! $ OMP reduction(.AND.:isLoopValid) ! $ OMP reduction(.AND.:isLoopValid)
do i = 1, is do i = 1, is
info = 0 info = 0
if (.not. isLoopValid) cycle if (.not. isLoopValid) cycle
if (mask(i)) then
ip = idx(i) ip = idx(i)
if ((ip < 1 ).or.(ip>mglob)) then if ((ip < 1 ).or.(ip>mglob)) then
idx(i) = -1 idx(i) = -1
@ -812,6 +725,7 @@ contains
& idxmap%hashv,idxmap%glb_lc,ncol) & idxmap%hashv,idxmap%glb_lc,ncol)
if (lip < 0) then if (lip < 0) then
!call OMP_set_lock(ins_lck) !call OMP_set_lock(ins_lck)
! We check again if the index is already in 'idxmap', this ! We check again if the index is already in 'idxmap', this
! time inside a critical region (we assume that the index ! time inside a critical region (we assume that the index
! is often already existing). ! is often already existing).
@ -823,9 +737,11 @@ contains
if (lip > 0) then if (lip > 0) then
idx(i) = lip idx(i) = lip
else if (lip < 0) then else if (lip < 0) then
! Index not found
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip lip = tlip
if (info >= 0) then if (info >= 0) then
! 'nxt' is not equal to 'tlip' when the key is already inside ! 'nxt' is not equal to 'tlip' when the key is already inside
! the hash map. In that case 'tlip' is the value corresponding ! the hash map. In that case 'tlip' is the value corresponding
@ -838,7 +754,7 @@ contains
& pad=-1_psb_lpk_,addsz=laddsz) & pad=-1_psb_lpk_,addsz=laddsz)
if (info /= psb_success_) then if (info /= psb_success_) then
!write(0,*) 'Error spot 2' !write(0,*) 'Error spot 1'
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err='psb_ensure_size',i_err=(/info/)) &a_err='psb_ensure_size',i_err=(/info/))
@ -858,160 +774,160 @@ contains
else else
idx(i) = lip idx(i) = lip
end if end if
else
end do idx(i) = -1
! $ OMP END PARALLEL DO
!$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) then
goto 9999
end if end if
end do
! $ OMP END PARALLEL DO
!$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) then
goto 9999
end if end if
else if (.not.present(lidx)) then else
if(present(mask)) then !$omp critical(hash_g2l_ins)
! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) &
! $ OMP shared(name,me,is,idx,ins_lck,mask,mglob,idxmap,ncol,nrow,laddsz) &
! $ OMP private(i,ip,lip,tlip,nxt,info) &
! $ OMP reduction(.AND.:isLoopValid)
!$omp critical(hash_g2l_ins)
do i = 1, is
info = 0
if (.not. isLoopValid) cycle
if (mask(i)) then
ip = idx(i)
if ((ip < 1 ).or.(ip>mglob)) then
idx(i) = -1
cycle
endif
!call OMP_set_lock(ins_lck)
ncol = idxmap%get_lc()
!call OMP_unset_lock(ins_lck)
! At first, we check the index presence in 'idxmap'. Usually ! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) &
! the index is found. If it is not found, we repeat the checking, ! $ OMP shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz,lidx) &
! but inside a critical region. ! $ OMP private(i,ip,lip,tlip,nxt,info) &
!write(0,*) me,name,' b hic 1 ',psb_errstatus_fatal() ! $ OMP reduction(.AND.:isLoopValid)
call hash_inner_cnv(ip,lip,idxmap%hashvmask,& do i = 1, is
& idxmap%hashv,idxmap%glb_lc,ncol) info = 0
!write(0,*) me,name,' a hic 1 ',psb_errstatus_fatal() if (.not. isLoopValid) cycle
if (lip < 0) then ip = idx(i)
!call OMP_set_lock(ins_lck) if ((ip < 1 ).or.(ip>mglob)) then
! We check again if the index is already in 'idxmap', this idx(i) = -1
! time inside a critical region (we assume that the index cycle
! is often already existing, so this lock is relatively rare). endif
ncol = idxmap%get_lc() !call OMP_set_lock(ins_lck)
nxt = ncol + 1 ncol = idxmap%get_lc()
!write(0,*) me,name,' b hic 2 ',psb_errstatus_fatal() !call OMP_unset_lock(ins_lck)
call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol) ! At first, we check the index presence in 'idxmap'. Usually
!write(0,*) me,name,' a hic 2 ',psb_errstatus_fatal() ! the index is found. If it is not found, we repeat the checking,
if (lip > 0) then ! but inside a critical region.
idx(i) = lip call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
else if (lip < 0) then & idxmap%hashv,idxmap%glb_lc,ncol)
! Index not found if (lip < 0) then
!write(0,*) me,name,' b hsik ',psb_errstatus_fatal() !call OMP_set_lock(ins_lck)
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) ! We check again if the index is already in 'idxmap', this
if (psb_errstatus_fatal()) write(0,*) me,name,' a hsik ',info,omp_get_thread_num() ! time inside a critical region (we assume that the index
!write(0,*) me,name,' a hsik ',psb_errstatus_fatal() ! is often already existing).
lip = tlip ncol = idxmap%get_lc()
nxt = lidx(i)
if (info >= 0) then call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
!write(0,*) 'Error before spot 3', info & idxmap%hashv,idxmap%glb_lc,ncol)
! 'nxt' is not equal to 'tlip' when the key is already inside
! the hash map. In that case 'tlip' is the value corresponding if (lip > 0) then
! to the existing mapping. idx(i) = lip
if (nxt == tlip) then else if (lip < 0) then
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
ncol = MAX(ncol,nxt) lip = tlip
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz) if (info >= 0) then
if (psb_errstatus_fatal()) write(0,*) me,name,' a esz ',info,omp_get_thread_num() ! 'nxt' is not equal to 'tlip' when the key is already inside
if (info /= psb_success_) then ! the hash map. In that case 'tlip' is the value corresponding
!write(0,*) 'Error spot 3', info ! to the existing mapping.
call psb_errpush(psb_err_from_subroutine_ai_,name,& if (nxt == tlip) then
&a_err='psb_ensure_size',i_err=(/info/))
ncol = MAX(ncol,nxt)
isLoopValid = .false.
idx(i) = -1 call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
else & pad=-1_psb_lpk_,addsz=laddsz)
idx(i) = lip
idxmap%loc_to_glob(nxt) = ip if (info /= psb_success_) then
call idxmap%set_lc(ncol) !write(0,*) 'Error spot 2'
end if call psb_errpush(psb_err_from_subroutine_ai_,name,&
end if &a_err='psb_ensure_size',i_err=(/info/))
else
isLoopValid = .false.
idx(i) = -1 idx(i) = -1
else
idx(i) = lip
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(ncol)
end if end if
!call OMP_unset_lock(ins_lck)
end if end if
else else
idx(i) = lip idx(i) = -1
end if end if
else !call OMP_unset_lock(ins_lck)
idx(i) = -1
end if end if
else
end do idx(i) = lip
! $ OMP END PARALLEL DO
!$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) then
goto 9999
end if end if
else
! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) & end do
! $ OMP shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz) & ! $ OMP END PARALLEL DO
! $ OMP private(i,ip,lip,tlip,nxt,info) & !$omp end critical(hash_g2l_ins)
! $ OMP reduction(.AND.:isLoopValid)
!$omp critical(hash_g2l_ins) if (.not. isLoopValid) then
do i = 1, is goto 9999
info = 0 end if
if (.not. isLoopValid) cycle end if
else if (.not.present(lidx)) then
if(present(mask)) then
! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) &
! $ OMP shared(name,me,is,idx,ins_lck,mask,mglob,idxmap,ncol,nrow,laddsz) &
! $ OMP private(i,ip,lip,tlip,nxt,info) &
! $ OMP reduction(.AND.:isLoopValid)
!$omp critical(hash_g2l_ins)
do i = 1, is
info = 0
if (.not. isLoopValid) cycle
if (mask(i)) then
ip = idx(i) ip = idx(i)
if ((ip < 1 ).or.(ip>mglob)) then if ((ip < 1 ).or.(ip>mglob)) then
idx(i) = -1 idx(i) = -1
cycle cycle
endif endif
!call OMP_set_lock(ins_lck) !call OMP_set_lock(ins_lck)
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
!call OMP_unset_lock(ins_lck) !call OMP_unset_lock(ins_lck)
! 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.
!write(0,*) me,name,' b hic 1 ',psb_errstatus_fatal()
call hash_inner_cnv(ip,lip,idxmap%hashvmask,& call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol) & idxmap%hashv,idxmap%glb_lc,ncol)
!write(0,*) me,name,' a hic 1 ',psb_errstatus_fatal()
if (lip < 0) then if (lip < 0) then
!call OMP_set_lock(ins_lck) !call OMP_set_lock(ins_lck)
! We check again if the index is already in 'idxmap', this ! We check again if the index is already in 'idxmap', this
! time inside a critical region (we assume that the index ! time inside a critical region (we assume that the index
! is often already existing). ! is often already existing, so this lock is relatively rare).
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
nxt = ncol + 1 nxt = ncol + 1
!write(0,*) me,name,' b hic 2 ',psb_errstatus_fatal()
call hash_inner_cnv(ip,lip,idxmap%hashvmask,& call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol) & idxmap%hashv,idxmap%glb_lc,ncol)
!write(0,*) me,name,' a hic 2 ',psb_errstatus_fatal()
if (lip > 0) then if (lip > 0) then
idx(i) = lip idx(i) = lip
else if (lip < 0) then else if (lip < 0) then
! Index not found ! Index not found
!write(0,*) me,name,' b hsik ',psb_errstatus_fatal()
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
if (psb_errstatus_fatal()) write(0,*) me,name,' a hsik ',info,omp_get_thread_num()
!write(0,*) me,name,' a hsik ',psb_errstatus_fatal()
lip = tlip lip = tlip
if (info >= 0) then if (info >= 0) then
!write(0,*) 'Error before spot 3', info
! 'nxt' is not equal to 'tlip' when the key is already inside ! 'nxt' is not equal to 'tlip' when the key is already inside
! the hash map. In that case 'tlip' is the value corresponding ! the hash map. In that case 'tlip' is the value corresponding
! to the existing mapping. ! to the existing mapping.
if (nxt == tlip) then if (nxt == tlip) then
ncol = MAX(ncol,nxt) ncol = MAX(ncol,nxt)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz) & pad=-1_psb_lpk_,addsz=laddsz)
if (psb_errstatus_fatal()) write(0,*) me,name,' a esz ',info,omp_get_thread_num()
if (info /= psb_success_) then if (info /= psb_success_) then
!write(0,*) 'Error spot 4' !write(0,*) 'Error spot 3', info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err='psb_ensure_size',i_err=(/info/)) &a_err='psb_ensure_size',i_err=(/info/))
@ -1028,116 +944,145 @@ contains
end if end if
!call OMP_unset_lock(ins_lck) !call OMP_unset_lock(ins_lck)
end if end if
else else
idx(i) = lip idx(i) = lip
end if end if
else
end do idx(i) = -1
! $ OMP END PARALLEL DO
!$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) then
goto 9999
end if end if
end if end do
end if ! $ OMP END PARALLEL DO
else !$omp end critical(hash_g2l_ins)
! Wrong state
idx = -1
info = -1
end if
!call OMP_destroy_lock(ins_lck)
#endif
else if (.not.use_openmp) then
#ifdef OPENMP
! $ omp parallel
! $ omp critical
!write(0,*) 'In cnv: ',omp_get_num_threads()
#endif
isLoopValid = .true.
if (idxmap%is_bld()) then
if (present(lidx)) then if (.not. isLoopValid) then
if (present(mask)) then goto 9999
do i = 1, is end if
else
! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) &
! $ OMP shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz) &
! $ OMP private(i,ip,lip,tlip,nxt,info) &
! $ OMP reduction(.AND.:isLoopValid)
!$omp critical(hash_g2l_ins)
do i = 1, is
info = 0
if (.not. isLoopValid) cycle
ip = idx(i)
if ((ip < 1 ).or.(ip>mglob)) then
idx(i) = -1
cycle
endif
!call OMP_set_lock(ins_lck)
ncol = idxmap%get_lc()
!call OMP_unset_lock(ins_lck)
! At first, we check the index presence in 'idxmap'. Usually
! the index is found. If it is not found, we repeat the checking,
! but inside a critical region.
call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol)
if (lip < 0) then
!call OMP_set_lock(ins_lck)
! We check again if the index is already in 'idxmap', this
! time inside a critical region (we assume that the index
! is often already existing).
ncol = idxmap%get_lc() ncol = idxmap%get_lc()
if (mask(i)) then nxt = ncol + 1
ip = idx(i) call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
if ((ip < 1 ).or.(ip>mglob) ) then & idxmap%hashv,idxmap%glb_lc,ncol)
idx(i) = -1
cycle if (lip > 0) then
endif idx(i) = lip
call hash_inner_cnv(ip,lip,idxmap%hashvmask,& else if (lip < 0) then
& idxmap%hashv,idxmap%glb_lc,ncol) ! Index not found
if (lip < 0) then call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
tlip = lip lip = tlip
nxt = lidx(i)
if (nxt <= nrow) then if (info >= 0) then
idx(i) = -1 ! 'nxt' is not equal to 'tlip' when the key is already inside
cycle ! the hash map. In that case 'tlip' is the value corresponding
endif ! to the existing mapping.
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) if (nxt == tlip) then
if (info >=0) then
if (nxt == tlip) then ncol = MAX(ncol,nxt)
ncol = max(ncol,nxt)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz) & pad=-1_psb_lpk_,addsz=laddsz)
if (info /= psb_success_) then
!write(0,*) 'Error spot' if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_ai_,name,& !write(0,*) 'Error spot 4'
&a_err='psb_ensure_size',i_err=(/info/)) call psb_errpush(psb_err_from_subroutine_ai_,name,&
isLoopValid = .false. &a_err='psb_ensure_size',i_err=(/info/))
end if
idxmap%loc_to_glob(nxt) = ip isLoopValid = .false.
idx(i) = -1
else
idx(i) = lip
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(ncol) call idxmap%set_lc(ncol)
endif end if
info = psb_success_
else
call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='SearchInsKeyVal',i_err=(/info/))
isLoopValid = .false.
end if end if
else
idx(i) = -1
end if end if
idx(i) = lip !call OMP_unset_lock(ins_lck)
info = psb_success_
else
idx(i) = -1
end if end if
enddo
else if (.not.present(mask)) then else
idx(i) = lip
end if
do i = 1, is end do
ncol = idxmap%get_lc() ! $ OMP END PARALLEL DO
ip = idx(i) !$omp end critical(hash_g2l_ins)
if ((ip < 1 ).or.(ip>mglob)) then
if (.not. isLoopValid) then
goto 9999
end if
end if
end if
else
! Wrong state
idx = -1
info = -1
end if
!call OMP_destroy_lock(ins_lck)
#else
!!$ else if (.not.use_openmp) then
isLoopValid = .true.
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 idx(i) = -1
cycle cycle
endif endif
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,& call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%glb_lc,ncol) & idxmap%hashv,idxmap%glb_lc,ncol)
if (lip < 0) then if (lip < 0) then
tlip = lip
nxt = lidx(i) nxt = lidx(i)
if (nxt <= nrow) then if (nxt <= nrow) then
idx(i) = -1 idx(i) = -1
cycle cycle
endif endif
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
if (info >=0) then if (info >=0) then
if (nxt == lip) then if (nxt == tlip) then
ncol = max(nxt,ncol) ncol = max(ncol,nxt)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,& call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz) & pad=-1_psb_lpk_,addsz=laddsz)
if (info /= psb_success_) then if (info /= psb_success_) then
info=1 !write(0,*) 'Error spot'
!write(0,*) 'Error spot'
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err='psb_ensure_size',i_err=(/info/)) &a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false. isLoopValid = .false.
end if end if
idxmap%loc_to_glob(nxt) = ip idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(ncol) call idxmap%set_lc(ncol)
@ -1151,66 +1096,71 @@ contains
end if end if
idx(i) = lip idx(i) = lip
info = psb_success_ info = psb_success_
enddo else
idx(i) = -1
end if
enddo
end if else if (.not.present(mask)) then
else if (.not.present(lidx)) 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 (present(mask)) then if (info >=0) then
do i = 1, is if (nxt == lip) then
if (mask(i)) then ncol = max(nxt,ncol)
ip = idx(i) call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
if ((ip < 1 ).or.(ip>mglob)) then & pad=-1_psb_lpk_,addsz=laddsz)
idx(i) = -1 if (info /= psb_success_) then
cycle info=1
!write(0,*) 'Error spot'
call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false.
end if
idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(ncol)
endif endif
ncol = idxmap%get_lc()
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
write(0,*) 'Error spot 5'
call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false.
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/))
isLoopValid = .false.
end if
idx(i) = lip
info = psb_success_ info = psb_success_
else else
idx(i) = -1 call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='SearchInsKeyVal',i_err=(/info/))
isLoopValid = .false.
end if end if
enddo end if
else if (.not.present(mask)) then idx(i) = lip
info = psb_success_
enddo
do i = 1, is end if
ncol = idxmap%get_lc()
ip = idx(i) else if (.not.present(lidx)) then
if (present(mask)) then
do i = 1, is
if (mask(i)) then
ip = idx(i)
if ((ip < 1 ).or.(ip>mglob)) then if ((ip < 1 ).or.(ip>mglob)) then
idx(i) = -1 idx(i) = -1
cycle cycle
endif endif
nxt = ncol + 1 ncol = idxmap%get_lc()
nxt = ncol + 1
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,& call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
& idxmap%glb_lc,ncol) & idxmap%glb_lc,ncol)
if (lip < 0) then if (lip < 0) then
@ -1225,41 +1175,80 @@ contains
& pad=-1_psb_lpk_,addsz=laddsz) & pad=-1_psb_lpk_,addsz=laddsz)
if (info /= psb_success_) then if (info /= psb_success_) then
info=1 info=1
write(0,*) 'Error spot 6' write(0,*) 'Error spot 5'
ch_err='psb_ensure_size'
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err=ch_err,i_err=(/info,izero,izero,izero,izero/)) & a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false. isLoopValid = .false.
end if end if
idxmap%loc_to_glob(nxt) = ip idxmap%loc_to_glob(nxt) = ip
call idxmap%set_lc(ncol) call idxmap%set_lc(ncol)
endif endif
info = psb_success_ info = psb_success_
else else
ch_err='SearchInsKeyVal'
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err=ch_err,i_err=(/info,izero,izero,izero,izero/)) & a_err='SearchInsKeyVal',i_err=(/info/))
isLoopValid = .false. isLoopValid = .false.
end if end if
idx(i) = lip idx(i) = lip
info = psb_success_ info = psb_success_
enddo 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
write(0,*) 'Error spot 6'
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/))
isLoopValid = .false.
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/))
isLoopValid = .false.
end if
idx(i) = lip
info = psb_success_
enddo
end if
end if end if
else
! Wrong state
idx = -1
info = -1
end if end if
#ifdef OPENMP else
! $ omp end critical ! Wrong state
! $ omp end parallel idx = -1
info = -1
#endif
if (.not. isLoopValid) goto 9999
end if end if
if (.not. isLoopValid) goto 9999
#endif
!write(0,*) me,name,' after loop ',psb_errstatus_fatal() !write(0,*) me,name,' after loop ',psb_errstatus_fatal()
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

Write Preview
Loading…
Cancel
Save