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

Exposed error in AMG test when not parallelizing generation loop

Browse Source
omp-walther
sfilippone 2 years ago
parent 494e29dd2e
commit 1941affe7a
6 changed files with 45 additions and 18 deletions
Show Stats Download Patch File Download Diff File

12
base/modules/auxil/psb_e_realloc_mod.F90
Unescape Escape View File

@ -139,7 +139,7 @@ Contains
name='psb_r_m_e_rk1' name='psb_r_m_e_rk1'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info=psb_success_ info=psb_success_
if (debug) write(psb_err_unit,*) 'reallocate D',len if (debug) write(psb_err_unit,*) 'e_reallocate D',len
if (present(lb)) then if (present(lb)) then
lb_ = lb lb_ = lb
@ -170,7 +170,7 @@ Contains
End If End If
else else
dim = 0 dim = 0
Allocate(rrax(lb_:ub_),stat=info) Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
err=4025 err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), & call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
@ -178,6 +178,7 @@ Contains
goto 9999 goto 9999
end if end if
endif endif
if (debug) write(psb_err_unit,*) 'reallocate 2 info',info
if (present(pad)) then if (present(pad)) then
!$omp parallel do private(i) shared(dim,len) !$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len do i=lb_-1+dim+1,lb_-1+len
@ -187,8 +188,9 @@ Contains
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
info = err info = err
!write(0,*) 'e_realloc : ',info
call psb_error_handler(err_act) call psb_error_handler(err_act)
return return
@ -986,7 +988,8 @@ Contains
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
write(0,*) 'From ensure_size: errstatus_fatal()'
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
goto 9999 goto 9999
end if end if
@ -1028,6 +1031,7 @@ Contains
!$OMP END CRITICAL !$OMP END CRITICAL
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) 'From ensure_size: ',info,psb_err_from_subroutine_
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc') call psb_errpush(info,name,a_err='psb_realloc')
goto 9999 goto 9999

2
base/modules/desc/psb_gen_block_map_mod.F90
Unescape Escape View File

@ -488,7 +488,7 @@ contains
integer(psb_ipk_) :: iam, np integer(psb_ipk_) :: iam, np
logical :: owned_ logical :: owned_
write(0,*) 'block_g2lv2' !write(0,*) 'block_g2lv2'
info = 0 info = 0
ctxt = idxmap%get_ctxt() ctxt = idxmap%get_ctxt()
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)

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

@ -515,7 +515,6 @@ contains
endif endif
end if end if
enddo enddo
else else
write(0,*) 'Hash status: invalid ',idxmap%get_state() write(0,*) 'Hash status: invalid ',idxmap%get_state()
idxout(1:is) = -1 idxout(1:is) = -1
@ -655,7 +654,7 @@ contains
#endif #endif
logical, volatile :: isLoopValid logical, volatile :: isLoopValid
info = psb_success_ info = psb_success_
name = 'hash_g2l_ins' name = 'hash_g2lv1_ins'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ctxt = idxmap%get_ctxt() ctxt = idxmap%get_ctxt()
@ -679,7 +678,7 @@ 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()
if (use_openmp) then if (use_openmp) then
#ifdef OPENMP #ifdef OPENMP
!call OMP_init_lock(ins_lck) !call OMP_init_lock(ins_lck)
@ -751,6 +750,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 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/))
@ -832,6 +832,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'
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/))
@ -883,38 +884,42 @@ contains
! 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, so this lock is relatively rare). ! 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)
!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 (info /= psb_success_) then if (info /= psb_success_) then
!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/))
@ -996,6 +1001,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 4'
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/))
@ -1069,6 +1075,7 @@ contains
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
!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.
@ -1113,9 +1120,11 @@ contains
if (info >=0) then if (info >=0) then
if (nxt == lip) then if (nxt == lip) then
ncol = max(nxt,ncol) ncol = max(nxt,ncol)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,pad=-1_psb_lpk_,addsz=laddsz) call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz)
if (info /= psb_success_) then if (info /= psb_success_) then
info=1 info=1
!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.
@ -1162,6 +1171,7 @@ 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 5'
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.
@ -1205,6 +1215,7 @@ 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'
ch_err='psb_ensure_size' 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=ch_err,i_err=(/info,izero,izero,izero,izero/))
@ -1239,6 +1250,7 @@ contains
#endif #endif
if (.not. isLoopValid) goto 9999 if (.not. isLoopValid) goto 9999
end if end if
!write(0,*) me,name,' after loop ',psb_errstatus_fatal()
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -1252,6 +1264,7 @@ contains
subroutine hash_g2lv2_ins(idxin,idxout,idxmap,info,mask,lidx) subroutine hash_g2lv2_ins(idxin,idxout,idxmap,info,mask,lidx)
use psb_realloc_mod use psb_realloc_mod
use psb_error_mod
implicit none implicit none
class(psb_hash_map), intent(inout) :: idxmap class(psb_hash_map), intent(inout) :: idxmap
integer(psb_lpk_), intent(in) :: idxin(:) integer(psb_lpk_), intent(in) :: idxin(:)
@ -1264,7 +1277,9 @@ contains
is = size(idxin) is = size(idxin)
im = min(is,size(idxout)) im = min(is,size(idxout))
!write(0,*) 'g2lv2_ins before realloc ',psb_errstatus_fatal()
call psb_realloc(im,tidx,info) call psb_realloc(im,tidx,info)
!write(0,*) 'g2lv2_ins after realloc ',psb_errstatus_fatal()
tidx(1:im) = idxin(1:im) tidx(1:im) = idxin(1:im)
call idxmap%g2lip_ins(tidx(1:im),info,mask=mask,lidx=lidx) call idxmap%g2lip_ins(tidx(1:im),info,mask=mask,lidx=lidx)
idxout(1:im) = tidx(1:im) idxout(1:im) = tidx(1:im)

7
base/modules/desc/psb_hash_mod.F90
Unescape Escape View File

@ -407,6 +407,7 @@ contains
if (hash%table(hk,1) == key) then if (hash%table(hk,1) == key) then
val = hash%table(hk,2) val = hash%table(hk,2)
info = HashDuplicate info = HashDuplicate
!write(0,*) 'In searchinskey 1 : ', info, HashDuplicate
return return
end if end if
!$omp critical(hashsearchins) !$omp critical(hashsearchins)
@ -440,11 +441,15 @@ contains
end if end if
end if end if
!$omp end critical(hashsearchins) !$omp end critical(hashsearchins)
if (info /= HashOk) return if (info /= HashOk) then
write(0,*) 'In searchinskey 2: ', info
return
end if
if (val > 0) return if (val > 0) return
hk = hk - hd hk = hk - hd
if (hk < 0) hk = hk + hsize if (hk < 0) hk = hk + hsize
end do end do
write(0,*) 'In searchinskey 3: ', info
end subroutine psb_hash_lsearchinskey end subroutine psb_hash_lsearchinskey
recursive subroutine psb_hash_isearchinskey(key,val,nextval,hash,info) recursive subroutine psb_hash_isearchinskey(key,val,nextval,hash,info)

8
base/tools/psb_dspins.F90
Unescape Escape View File

@ -137,10 +137,12 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
#if defined(OPENMP) #if defined(OPENMP)
!$omp parallel private(ila,jla,nrow,ncol,nnl,k) !$omp parallel private(ila,jla,nrow,ncol,nnl,k)
#endif #endif
!write(0,*) me,' Before g2l ',psb_errstatus_fatal()
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
!write(0,*) me,' Before g2l_ins ',psb_errstatus_fatal()
if (info == 0) call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,& if (info == 0) call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,&
& mask=(ila(1:nz)>0)) & mask=(ila(1:nz)>0))
!write(0,*) me,' after g2l_ins ',psb_errstatus_fatal(),info
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='psb_cdins',i_err=(/info/)) & a_err='psb_cdins',i_err=(/info/))
@ -148,7 +150,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
end if end if
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
!write(0,*) me,' Before csput',psb_errstatus_fatal()
if (a%is_bld()) then if (a%is_bld()) then
call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info) call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -181,7 +183,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
call psb_errpush(info,name) call psb_errpush(info,name)
!goto 9999 !goto 9999
end if end if
!write(0,*) me,' after csput',psb_errstatus_fatal()
#if defined(OPENMP) #if defined(OPENMP)
!$omp end parallel !$omp end parallel
#endif #endif

1
test/pargen/psb_d_pde3d.F90
Unescape Escape View File

@ -737,6 +737,7 @@ program psb_d_pde3d
! !
! allocate and fill in the coefficient matrix, rhs and initial guess ! allocate and fill in the coefficient matrix, rhs and initial guess
! !
call psb_cd_set_large_threshold(100_psb_lpk_)
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()
call psb_gen_pde3d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) call psb_gen_pde3d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart)

Write Preview
Loading…
Cancel
Save