diff --git a/base/modules/auxil/psb_e_realloc_mod.F90 b/base/modules/auxil/psb_e_realloc_mod.F90 index 0f2431fd..e11abd7c 100644 --- a/base/modules/auxil/psb_e_realloc_mod.F90 +++ b/base/modules/auxil/psb_e_realloc_mod.F90 @@ -139,7 +139,7 @@ Contains name='psb_r_m_e_rk1' call psb_erractionsave(err_act) 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 lb_ = lb @@ -170,7 +170,7 @@ Contains End If else dim = 0 - Allocate(rrax(lb_:ub_),stat=info) + Allocate(rrax(lb_:ub_),stat=info) if (info /= psb_success_) then err=4025 call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), & @@ -178,6 +178,7 @@ Contains goto 9999 end if endif + if (debug) write(psb_err_unit,*) 'reallocate 2 info',info if (present(pad)) then !$omp parallel do private(i) shared(dim,len) do i=lb_-1+dim+1,lb_-1+len @@ -187,8 +188,9 @@ Contains call psb_erractionrestore(err_act) return -9999 continue +9999 continue info = err + !write(0,*) 'e_realloc : ',info call psb_error_handler(err_act) return @@ -986,7 +988,8 @@ Contains call psb_erractionsave(err_act) 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_ goto 9999 end if @@ -1028,6 +1031,7 @@ Contains !$OMP END CRITICAL if (info /= psb_success_) then + write(0,*) 'From ensure_size: ',info,psb_err_from_subroutine_ info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='psb_realloc') goto 9999 diff --git a/base/modules/desc/psb_gen_block_map_mod.F90 b/base/modules/desc/psb_gen_block_map_mod.F90 index 2c20a547..f0c433e0 100644 --- a/base/modules/desc/psb_gen_block_map_mod.F90 +++ b/base/modules/desc/psb_gen_block_map_mod.F90 @@ -488,7 +488,7 @@ contains integer(psb_ipk_) :: iam, np logical :: owned_ - write(0,*) 'block_g2lv2' + !write(0,*) 'block_g2lv2' info = 0 ctxt = idxmap%get_ctxt() call psb_info(ctxt,iam,np) diff --git a/base/modules/desc/psb_hash_map_mod.F90 b/base/modules/desc/psb_hash_map_mod.F90 index eac8cc7a..4e04a371 100644 --- a/base/modules/desc/psb_hash_map_mod.F90 +++ b/base/modules/desc/psb_hash_map_mod.F90 @@ -515,7 +515,6 @@ contains endif end if enddo - else write(0,*) 'Hash status: invalid ',idxmap%get_state() idxout(1:is) = -1 @@ -655,7 +654,7 @@ contains #endif logical, volatile :: isLoopValid info = psb_success_ - name = 'hash_g2l_ins' + name = 'hash_g2lv1_ins' call psb_erractionsave(err_act) ctxt = idxmap%get_ctxt() @@ -679,7 +678,7 @@ contains mglob = idxmap%get_gr() nrow = idxmap%get_lr() - + !write(0,*) me,name,' before loop ',psb_errstatus_fatal() if (use_openmp) then #ifdef OPENMP !call OMP_init_lock(ins_lck) @@ -751,6 +750,7 @@ contains & 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/)) @@ -832,6 +832,7 @@ contains & pad=-1_psb_lpk_,addsz=laddsz) if (info /= psb_success_) then + !write(0,*) 'Error spot 2' call psb_errpush(psb_err_from_subroutine_ai_,name,& &a_err='psb_ensure_size',i_err=(/info/)) @@ -883,38 +884,42 @@ contains ! 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. + !write(0,*) me,name,' b hic 1 ',psb_errstatus_fatal() call hash_inner_cnv(ip,lip,idxmap%hashvmask,& & idxmap%hashv,idxmap%glb_lc,ncol) - + !write(0,*) me,name,' a hic 1 ',psb_errstatus_fatal() 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, so this lock is relatively rare). 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,& & idxmap%hashv,idxmap%glb_lc,ncol) - + !write(0,*) me,name,' a hic 2 ',psb_errstatus_fatal() if (lip > 0) then idx(i) = lip else if (lip < 0) then ! Index not found + !write(0,*) me,name,' b hsik ',psb_errstatus_fatal() call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info) + !write(0,*) me,name,' a hsik ',psb_errstatus_fatal() lip = tlip if (info >= 0) then + !write(0,*) 'Error before spot 3', info ! '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 3', info call psb_errpush(psb_err_from_subroutine_ai_,name,& &a_err='psb_ensure_size',i_err=(/info/)) @@ -996,6 +1001,7 @@ contains & pad=-1_psb_lpk_,addsz=laddsz) if (info /= psb_success_) then + !write(0,*) 'Error spot 4' call psb_errpush(psb_err_from_subroutine_ai_,name,& &a_err='psb_ensure_size',i_err=(/info/)) @@ -1069,6 +1075,7 @@ contains 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' call psb_errpush(psb_err_from_subroutine_ai_,name,& &a_err='psb_ensure_size',i_err=(/info/)) isLoopValid = .false. @@ -1113,9 +1120,11 @@ contains 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) + 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' call psb_errpush(psb_err_from_subroutine_ai_,name,& &a_err='psb_ensure_size',i_err=(/info/)) isLoopValid = .false. @@ -1162,6 +1171,7 @@ contains & 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. @@ -1205,6 +1215,7 @@ contains & 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/)) @@ -1239,6 +1250,7 @@ contains #endif if (.not. isLoopValid) goto 9999 end if + !write(0,*) me,name,' after loop ',psb_errstatus_fatal() call psb_erractionrestore(err_act) return @@ -1252,6 +1264,7 @@ contains subroutine hash_g2lv2_ins(idxin,idxout,idxmap,info,mask,lidx) use psb_realloc_mod + use psb_error_mod implicit none class(psb_hash_map), intent(inout) :: idxmap integer(psb_lpk_), intent(in) :: idxin(:) @@ -1264,7 +1277,9 @@ contains is = size(idxin) im = min(is,size(idxout)) + !write(0,*) 'g2lv2_ins before realloc ',psb_errstatus_fatal() call psb_realloc(im,tidx,info) + !write(0,*) 'g2lv2_ins after realloc ',psb_errstatus_fatal() tidx(1:im) = idxin(1:im) call idxmap%g2lip_ins(tidx(1:im),info,mask=mask,lidx=lidx) idxout(1:im) = tidx(1:im) diff --git a/base/modules/desc/psb_hash_mod.F90 b/base/modules/desc/psb_hash_mod.F90 index c3c5ba20..68e10a05 100644 --- a/base/modules/desc/psb_hash_mod.F90 +++ b/base/modules/desc/psb_hash_mod.F90 @@ -407,6 +407,7 @@ contains if (hash%table(hk,1) == key) then val = hash%table(hk,2) info = HashDuplicate + !write(0,*) 'In searchinskey 1 : ', info, HashDuplicate return end if !$omp critical(hashsearchins) @@ -440,11 +441,15 @@ contains end if end if !$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 hk = hk - hd if (hk < 0) hk = hk + hsize end do + write(0,*) 'In searchinskey 3: ', info end subroutine psb_hash_lsearchinskey recursive subroutine psb_hash_isearchinskey(key,val,nextval,hash,info) diff --git a/base/tools/psb_dspins.F90 b/base/tools/psb_dspins.F90 index 3b7e0e80..094d0a4b 100644 --- a/base/tools/psb_dspins.F90 +++ b/base/tools/psb_dspins.F90 @@ -137,10 +137,12 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) #if defined(OPENMP) !$omp parallel private(ila,jla,nrow,ncol,nnl,k) #endif + !write(0,*) me,' Before g2l ',psb_errstatus_fatal() 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,& & mask=(ila(1:nz)>0)) - + !write(0,*) me,' after g2l_ins ',psb_errstatus_fatal(),info if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_ai_,name,& & 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 nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() - + !write(0,*) me,' Before csput',psb_errstatus_fatal() if (a%is_bld()) then call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info) 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) !goto 9999 end if - + !write(0,*) me,' after csput',psb_errstatus_fatal() #if defined(OPENMP) !$omp end parallel #endif diff --git a/test/pargen/psb_d_pde3d.F90 b/test/pargen/psb_d_pde3d.F90 index 6e895c00..eebc5ad8 100644 --- a/test/pargen/psb_d_pde3d.F90 +++ b/test/pargen/psb_d_pde3d.F90 @@ -737,6 +737,7 @@ program psb_d_pde3d ! ! allocate and fill in the coefficient matrix, rhs and initial guess ! + call psb_cd_set_large_threshold(100_psb_lpk_) call psb_barrier(ctxt) t1 = psb_wtime() call psb_gen_pde3d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart)