diff --git a/base/modules/desc/psb_gen_block_map_mod.F90 b/base/modules/desc/psb_gen_block_map_mod.F90 index dfb47b61..2c20a547 100644 --- a/base/modules/desc/psb_gen_block_map_mod.F90 +++ b/base/modules/desc/psb_gen_block_map_mod.F90 @@ -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) diff --git a/base/modules/desc/psb_glist_map_mod.f90 b/base/modules/desc/psb_glist_map_mod.F90 similarity index 100% rename from base/modules/desc/psb_glist_map_mod.f90 rename to base/modules/desc/psb_glist_map_mod.F90 diff --git a/base/modules/desc/psb_hash_map_mod.F90 b/base/modules/desc/psb_hash_map_mod.F90 index af9cdf61..0f9af7ef 100644 --- a/base/modules/desc/psb_hash_map_mod.F90 +++ b/base/modules/desc/psb_hash_map_mod.F90 @@ -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 diff --git a/base/modules/desc/psb_hash_mod.F90 b/base/modules/desc/psb_hash_mod.F90 index 0c682670..c3c5ba20 100644 --- a/base/modules/desc/psb_hash_mod.F90 +++ b/base/modules/desc/psb_hash_mod.F90 @@ -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 diff --git a/base/modules/desc/psb_list_map_mod.f90 b/base/modules/desc/psb_list_map_mod.F90 similarity index 92% rename from base/modules/desc/psb_list_map_mod.f90 rename to base/modules/desc/psb_list_map_mod.F90 index 3e3c8e25..5961d5c2 100644 --- a/base/modules/desc/psb_list_map_mod.f90 +++ b/base/modules/desc/psb_list_map_mod.F90 @@ -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 diff --git a/base/modules/desc/psb_repl_map_mod.f90 b/base/modules/desc/psb_repl_map_mod.F90 similarity index 100% rename from base/modules/desc/psb_repl_map_mod.f90 rename to base/modules/desc/psb_repl_map_mod.F90