fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-07 07:04:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

Put CRITICAL(name) in G2L_INS

Browse Source
This commit is contained in:
sfilippone
2023-04-14 17:48:15 +02:00
parent 0f1603a2e9
commit eb11e5e053
6 changed files with 125 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/desc/psb_gen_block_map_mod.F90
+1
View File
@@ -488,6 +488,7 @@ contains
integer(psb_ipk_) :: iam, np
logical :: owned_
write(0,*) 'block_g2lv2'
info = 0
ctxt = idxmap%get_ctxt()
call psb_info(ctxt,iam,np)
base/modules/desc/psb_glist_map_mod.f90 → base/modules/desc/psb_glist_map_mod.F90
View File
base/modules/desc/psb_hash_map_mod.F90
+40 -51
View File
@@ -207,7 +207,6 @@ contains
integer(psb_ipk_) :: i
logical :: owned_
info = 0
if (present(mask)) then
if (size(mask) < size(idx)) then
info = -1
@@ -249,7 +248,6 @@ contains
end do
end if
end subroutine hash_l2gv1
subroutine hash_l2gv2(idxin,idxout,idxmap,info,mask,owned)
@@ -334,7 +332,6 @@ contains
info = 0
ctxt = idxmap%get_ctxt()
call psb_info(ctxt,iam,np)
if (present(mask)) then
if (size(mask) < size(idx)) then
info = -1
@@ -437,7 +434,6 @@ contains
end if
end if
end subroutine hash_g2lv1
subroutine hash_g2lv2(idxin,idxout,idxmap,info,mask,owned)
@@ -460,7 +456,6 @@ contains
is = size(idxin)
im = min(is,size(idxout))
info = 0
ctxt = idxmap%get_ctxt()
call psb_info(ctxt,iam,np)
@@ -567,7 +562,6 @@ contains
end if
end if
end subroutine hash_g2lv2
@@ -688,14 +682,13 @@ contains
if (use_openmp) then
#ifdef OPENMP
call OMP_init_lock(ins_lck)
!call OMP_init_lock(ins_lck)
if (idxmap%is_bld()) then
isLoopValid = .true.
ncol = idxmap%get_lc()
if (present(mask)) then
!write(0,*) 'present mask'
mask_ = mask
else
allocate(mask_(size(idx)))
@@ -703,13 +696,12 @@ contains
end if
if (present(lidx)) then
!write(0,*) 'present lidx'
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,lidx) &
!$OMP private(i,ip,lip,tlip,nxt,info) &
!$OMP reduction(.AND.:isLoopValid)
! $ 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 (mask(i)) then
@@ -718,9 +710,9 @@ contains
idx(i) = -1
cycle
endif
call OMP_set_lock(ins_lck)
!call OMP_set_lock(ins_lck)
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
! the index is found. If it is not found, we repeat the checking,
@@ -728,7 +720,7 @@ contains
call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol)
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
! time inside a critical region (we assume that the index
@@ -772,7 +764,7 @@ contains
else
idx(i) = -1
end if
call OMP_unset_lock(ins_lck)
!call OMP_unset_lock(ins_lck)
end if
else
idx(i) = lip
@@ -782,17 +774,17 @@ contains
end if
end do
!$OMP END PARALLEL DO
! $ OMP END PARALLEL DO
if (.not. isLoopValid) then
goto 9999
end if
else
!$OMP PARALLEL DO default(none) schedule(DYNAMIC) &
!$OMP shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz,lidx) &
!$OMP private(i,ip,lip,tlip,nxt,info) &
!$OMP reduction(.AND.:isLoopValid)
! $ OMP PARALLEL DO default(none) schedule(DYNAMIC) &
! $ OMP shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz,lidx) &
! $ OMP private(i,ip,lip,tlip,nxt,info) &
! $ OMP reduction(.AND.:isLoopValid)
do i = 1, is
info = 0
ip = idx(i)
@@ -800,9 +792,9 @@ contains
idx(i) = -1
cycle
endif
call OMP_set_lock(ins_lck)
!call OMP_set_lock(ins_lck)
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
! the index is found. If it is not found, we repeat the checking,
@@ -810,7 +802,7 @@ contains
call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol)
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
! time inside a critical region (we assume that the index
! is often already existing).
@@ -851,26 +843,25 @@ contains
else
idx(i) = -1
end if
call OMP_unset_lock(ins_lck)
!call OMP_unset_lock(ins_lck)
end if
else
idx(i) = lip
end if
end do
!$OMP END PARALLEL DO
! $ OMP END PARALLEL DO
if (.not. isLoopValid) then
goto 9999
end if
end if
else if (.not.present(lidx)) then
!write(0,*) 'not present lidx'
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 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)
do i = 1, is
info = 0
if (mask(i)) then
@@ -879,9 +870,9 @@ contains
idx(i) = -1
cycle
endif
call OMP_set_lock(ins_lck)
!call OMP_set_lock(ins_lck)
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
! the index is found. If it is not found, we repeat the checking,
@@ -890,7 +881,7 @@ contains
& idxmap%hashv,idxmap%glb_lc,ncol)
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
! time inside a critical region (we assume that the index
! is often already existing, so this lock is relatively rare).
@@ -932,7 +923,7 @@ contains
else
idx(i) = -1
end if
call OMP_unset_lock(ins_lck)
!call OMP_unset_lock(ins_lck)
end if
else
idx(i) = lip
@@ -942,16 +933,16 @@ contains
end if
end do
!$OMP END PARALLEL DO
! $ OMP END PARALLEL DO
if (.not. isLoopValid) then
goto 9999
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 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)
do i = 1, is
info = 0
ip = idx(i)
@@ -959,9 +950,9 @@ contains
idx(i) = -1
cycle
endif
call OMP_set_lock(ins_lck)
!call OMP_set_lock(ins_lck)
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
! the index is found. If it is not found, we repeat the checking,
@@ -969,7 +960,7 @@ contains
call hash_inner_cnv(ip,lip,idxmap%hashvmask,&
& idxmap%hashv,idxmap%glb_lc,ncol)
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
! time inside a critical region (we assume that the index
! is often already existing).
@@ -1011,7 +1002,7 @@ contains
else
idx(i) = -1
end if
call OMP_unset_lock(ins_lck)
!call OMP_unset_lock(ins_lck)
end if
else
@@ -1019,7 +1010,7 @@ contains
end if
end do
!$OMP END PARALLEL DO
! $ OMP END PARALLEL DO
if (.not. isLoopValid) then
goto 9999
@@ -1032,7 +1023,7 @@ contains
idx = -1
info = -1
end if
call OMP_destroy_lock(ins_lck)
!call OMP_destroy_lock(ins_lck)
#endif
else if (.not.use_openmp) then
@@ -1139,9 +1130,9 @@ contains
else if (.not.present(lidx)) then
if (present(mask)) then
if (present(mask)) then
do i = 1, is
if (mask(i)) then
if (mask(i)) then
ip = idx(i)
if ((ip < 1 ).or.(ip>mglob)) then
idx(i) = -1
@@ -1182,7 +1173,6 @@ contains
idx(i) = -1
end if
enddo
else if (.not.present(mask)) then
do i = 1, is
@@ -1227,7 +1217,6 @@ contains
info = psb_success_
enddo
end if
end if
else
base/modules/desc/psb_hash_mod.F90
+27 -22
View File
@@ -409,34 +409,39 @@ contains
info = HashDuplicate
return
end if
!$OMP CRITICAL
if (hash%table(hk,1) == HashFreeEntry) then
if (hash%nk == hash%hsize -1) then
!
! Note: because of the way we allocate things at CDALL
! time this is really unlikely; if we get here, we
! have at least as many halo indices as internals, which
! means we're already in trouble. But we try to keep going.
!
call psb_hash_realloc(hash,info)
if (info /= HashOk) then
info = HashOutOfMemory
!return
!$omp critical(hashsearchins)
if (hash%table(hk,1) == key) then
val = hash%table(hk,2)
info = HashDuplicate
else
if (hash%table(hk,1) == HashFreeEntry) then
if (hash%nk == hash%hsize -1) then
!
! Note: because of the way we allocate things at CDALL
! time this is really unlikely; if we get here, we
! have at least as many halo indices as internals, which
! means we're already in trouble. But we try to keep going.
!
call psb_hash_realloc(hash,info)
if (info /= HashOk) then
info = HashOutOfMemory
!return
else
call psb_hash_searchinskey(key,val,nextval,hash,info)
!return
end if
else
call psb_hash_searchinskey(key,val,nextval,hash,info)
hash%nk = hash%nk + 1
hash%table(hk,1) = key
hash%table(hk,2) = nextval
val = nextval
!return
end if
else
hash%nk = hash%nk + 1
hash%table(hk,1) = key
hash%table(hk,2) = nextval
val = nextval
!return
end if
end if
!$OMP END CRITICAL
!$omp end critical(hashsearchins)
if (info /= HashOk) return
if (val > 0) return
if (val > 0) return
hk = hk - hd
if (hk < 0) hk = hk + hsize
end do
base/modules/desc/psb_list_map_mod.f90 → base/modules/desc/psb_list_map_mod.F90
+57 -2
View File
@@ -349,7 +349,6 @@ contains
logical :: owned_
info = 0
if (present(mask)) then
if (size(mask) < size(idxin)) then
info = -1
@@ -644,7 +643,20 @@ contains
if (mask(i)) then
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
#if defined(OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
ix = lidx(i)
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) info = -4
idxmap%local_cols = max(ix,idxmap%local_cols)
idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix
end if
!$OMP END CRITICAL(LISTINS)
#else
ix = lidx(i)
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if ((ix <= idxmap%local_rows).or.(info /= 0)) then
@@ -654,6 +666,7 @@ contains
idxmap%local_cols = max(ix,idxmap%local_cols)
idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix
#endif
end if
idxout(i) = ix
else
@@ -668,6 +681,19 @@ contains
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
#if defined(OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
ix = lidx(i)
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) info = -4
idxmap%local_cols = max(ix,idxmap%local_cols)
idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix
end if
!$OMP END CRITICAL(LISTINS)
#else
ix = lidx(i)
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if ((ix <= idxmap%local_rows).or.(info /= 0)) then
@@ -677,6 +703,7 @@ contains
idxmap%local_cols = max(ix,idxmap%local_cols)
idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix
#endif
end if
idxout(i) = ix
else
@@ -692,7 +719,20 @@ contains
if (mask(i)) then
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
if (ix < 0) then
#if defined(OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
ix = idxmap%local_cols + 1
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) info = -4
idxmap%local_cols = ix
idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix
end if
!$OMP END CRITICAL(LISTINS)
#else
ix = idxmap%local_cols + 1
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) then
@@ -702,6 +742,7 @@ contains
idxmap%local_cols = ix
idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix
#endif
end if
idxout(i) = ix
else
@@ -716,6 +757,19 @@ contains
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
#if defined(OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
ix = idxmap%local_cols + 1
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) info = -4
idxmap%local_cols = ix
idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix
end if
!$OMP END CRITICAL(LISTINS)
#else
ix = idxmap%local_cols + 1
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) then
@@ -725,6 +779,7 @@ contains
idxmap%local_cols = ix
idxmap%loc_to_glob(ix) = idxin(i)
idxmap%glob_to_loc(idxin(i)) = ix
#endif
end if
idxout(i) = ix
else
base/modules/desc/psb_repl_map_mod.f90 → base/modules/desc/psb_repl_map_mod.F90
View File