diff --git a/src/modules/psb_const_mod.f90 b/src/modules/psb_const_mod.f90 index 7ede5c7f..9126604c 100644 --- a/src/modules/psb_const_mod.f90 +++ b/src/modules/psb_const_mod.f90 @@ -59,13 +59,15 @@ module psb_const_mod integer, parameter :: psb_dec_type_=1, psb_m_=2,psb_n_=3 integer, parameter :: psb_n_row_=4, psb_n_col_=5,psb_ctxt_=6 integer, parameter :: psb_loc_to_glob_=7 + integer, parameter :: psb_ovl_state_=8 + integer, parameter :: psb_mpi_c_=9 integer, parameter :: psb_thal_xch_=11 integer, parameter :: psb_thal_snd_=12 integer, parameter :: psb_thal_rcv_=13 integer, parameter :: psb_tovr_xch_=14 integer, parameter :: psb_tovr_snd_=15 integer, parameter :: psb_tovr_rcv_=16 - integer, parameter :: psb_mpi_c_=9,psb_mdata_size_=20 + integer, parameter :: psb_mdata_size_=20 integer, parameter :: psb_desc_asb_=3099 integer, parameter :: psb_desc_bld_=psb_desc_asb_+1 integer, parameter :: psb_desc_repl_=3199 @@ -73,6 +75,8 @@ module psb_const_mod integer, parameter :: psb_desc_upd_asb_=psb_desc_upd_+1 integer, parameter :: psb_desc_large_asb_=psb_desc_upd_asb_+1 integer, parameter :: psb_desc_large_bld_=psb_desc_large_asb_+1 + integer, parameter :: psb_cd_ovl_bld_=psb_desc_large_bld_+1 + integer, parameter :: psb_cd_ovl_asb_=psb_cd_ovl_bld_+1 integer, parameter :: nbits=14 integer, parameter :: hashsize=2**nbits, hashmask=hashsize-1 integer, parameter :: psb_default_large_threshold=4*1024*1024 ! to be reviewed diff --git a/src/modules/psb_desc_type.f90 b/src/modules/psb_desc_type.f90 index 5a643d2b..6253c8da 100644 --- a/src/modules/psb_desc_type.f90 +++ b/src/modules/psb_desc_type.f90 @@ -136,6 +136,28 @@ contains end function psb_is_asb_desc + logical function psb_is_ovl_bld(desc) + type(psb_desc_type), intent(in) :: desc + + psb_is_ovl_bld = (desc%matrix_data(psb_ovl_state_)==psb_cd_ovl_bld_) + + end function psb_is_ovl_bld + + logical function psb_is_ovl_asb(desc) + type(psb_desc_type), intent(in) :: desc + + psb_is_ovl_asb = (desc%matrix_data(psb_ovl_state_)==psb_cd_ovl_asb_) + + end function psb_is_ovl_asb + + logical function psb_is_ovl_ok(desc) + type(psb_desc_type), intent(in) :: desc + + psb_is_ovl_ok = (desc%matrix_data(psb_ovl_state_)==psb_cd_ovl_asb_).or.& + & (desc%matrix_data(psb_ovl_state_)==psb_cd_ovl_bld_) + + end function psb_is_ovl_ok + logical function psb_is_ok_dec(dectype) integer :: dectype @@ -228,6 +250,11 @@ contains end function psb_is_large_dec subroutine psb_cd_set_bld(desc,info) + ! + ! Change state of a descriptor into BUILD. + ! If the descriptor is LARGE, check the AVL search tree + ! and initialize it if necessary. + ! use psb_const_mod use psb_error_mod use psb_penv_mod @@ -243,7 +270,7 @@ contains if (psb_get_errstatus() /= 0) return info = 0 call psb_erractionsave(err_act) - name = 'psb_cdcpy' + name = 'psb_cd_set_bld' ictxt = psb_cd_get_context(desc) diff --git a/src/modules/psi_mod.f90 b/src/modules/psi_mod.f90 index c683a579..beaa7d89 100644 --- a/src/modules/psi_mod.f90 +++ b/src/modules/psi_mod.f90 @@ -430,6 +430,7 @@ contains call psb_errpush(4010,name,a_err='psi_crea_ovr_elem') goto 9999 end if + cdesc%matrix_data(psb_ovl_state_)=psb_cd_ovl_asb_ ! finally bnd_elem call psi_crea_bnd_elem(idx_out,cdesc,info) diff --git a/src/tools/psb_cdall.f90 b/src/tools/psb_cdall.f90 index 84d1c6a7..96327f79 100644 --- a/src/tools/psb_cdall.f90 +++ b/src/tools/psb_cdall.f90 @@ -228,6 +228,7 @@ subroutine psb_cdall(m, n, parts, ictxt, desc_a, info) goto 9999 endif loc_row = k + else desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_ @@ -376,13 +377,15 @@ subroutine psb_cdall(m, n, parts, ictxt, desc_a, info) call psb_transfer(ov_idx,desc_a%ovrlap_index,info) if (info == 0) call psb_transfer(ov_el,desc_a%ovrlap_elem,info) - deallocate(prc_v,temp_ovrlap,stat=info) + if (info == 0) deallocate(prc_v,temp_ovrlap,stat=info) if (info /= no_err) then info=4000 err=info call psb_errpush(err,name) Goto 9999 endif + ! At this point overlap is OK. + desc_a%matrix_data(psb_ovl_state_) = psb_cd_ovl_asb_ ! set fields in desc_a%MATRIX_DATA.... desc_a%matrix_data(psb_n_row_) = loc_row diff --git a/src/tools/psb_cdalv.f90 b/src/tools/psb_cdalv.f90 index 67a4e338..5c611f0e 100644 --- a/src/tools/psb_cdalv.f90 +++ b/src/tools/psb_cdalv.f90 @@ -325,12 +325,13 @@ subroutine psb_cdalv(m, v, ictxt, desc_a, info, flag) call psb_transfer(ov_idx,desc_a%ovrlap_index,info) if (info == 0) call psb_transfer(ov_el,desc_a%ovrlap_elem,info) - deallocate(temp_ovrlap,stat=info) + if (info == 0) deallocate(temp_ovrlap,stat=info) if (info /= 0) then info=4000 call psb_errpush(info,name) goto 9999 endif + desc_a%matrix_data(psb_ovl_state_) = psb_cd_ovl_asb_ ! set fields in desc_a%MATRIX_DATA.... desc_a%matrix_data(psb_n_row_) = loc_row diff --git a/src/tools/psb_cddec.f90 b/src/tools/psb_cddec.f90 index 9fea6a97..b884094f 100644 --- a/src/tools/psb_cddec.f90 +++ b/src/tools/psb_cddec.f90 @@ -254,6 +254,8 @@ subroutine psb_cddec(nloc, ictxt, desc_a, info) desc_a%lprm(:) = 0 + desc_a%matrix_data(psb_ovl_state_) = psb_cd_ovl_bld_ + call psi_cnv_dsc(thalo,tovr,desc_a,info) if (info /= 0) then call psb_errpush(4010,name,a_err='psi_bld_cdesc') diff --git a/src/tools/psb_dcdovr.f90 b/src/tools/psb_dcdovr.f90 index d6ecb12d..a7fb01e3 100644 --- a/src/tools/psb_dcdovr.f90 +++ b/src/tools/psb_dcdovr.f90 @@ -158,6 +158,7 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info) l_tmp_halo = novr*(3*Size(desc_a%halo_index)) call psb_cd_set_bld(desc_ov,info) + desc_ov%matrix_data(psb_ovl_state_)=psb_cd_ovl_bld_ If(debug) then Write(0,*)'Start cdovrbld',me,lworks,lworkr diff --git a/src/tools/psb_get_overlap.f90 b/src/tools/psb_get_overlap.f90 index ca4d1427..1a56cde5 100644 --- a/src/tools/psb_get_overlap.f90 +++ b/src/tools/psb_get_overlap.f90 @@ -11,25 +11,24 @@ subroutine psb_get_ovrlap(ovrel,desc,info) character(len=20) :: name info = 0 - name='psi_get_overlap' + name='psb_get_overlap' call psb_erractionsave(err_act) - i=0 - j=1 - do while(desc%ovrlap_elem(j) /= -1) - i = i +1 - j = j + 2 - enddo - - if (i > 0) then + if (psb_is_ovl_bld(desc)) then + i=0 + j=1 + do while(desc%ovrlap_elem(j) /= -1) + i = i +1 + j = j + 2 + enddo - allocate(ovrel(i),stat=info) + call psb_realloc(i,ovrel,info) if (info /= 0 ) then info = 4000 call psb_errpush(info,name) goto 9999 end if - + i=0 j=1 do while(desc%ovrlap_elem(j) /= -1) @@ -39,17 +38,10 @@ subroutine psb_get_ovrlap(ovrel,desc,info) enddo else - - if (allocated(ovrel)) then - deallocate(ovrel,stat=info) - if (info /= 0) then - call psb_errpush(4010,name,a_err='Deallocate') - goto 9999 - end if - end if - + info = 1122 + call psb_errpush(info,name) + goto 9999 end if - call psb_erractionrestore(err_act) return diff --git a/src/tools/psb_zcdovr.f90 b/src/tools/psb_zcdovr.f90 index 0d4a94fb..8cf423ff 100644 --- a/src/tools/psb_zcdovr.f90 +++ b/src/tools/psb_zcdovr.f90 @@ -157,11 +157,8 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info) l_tmp_halo = novr*(3*Size(desc_a%halo_index)) call psb_cd_set_bld(desc_ov,info) -!!$ if (psb_is_large_desc(desc_a)) then -!!$ desc_ov%matrix_data(psb_dec_type_) = psb_desc_large_bld_ -!!$ else -!!$ desc_ov%matrix_data(psb_dec_type_) = psb_desc_bld_ -!!$ end if + desc_ov%matrix_data(psb_ovl_state_)=psb_cd_ovl_bld_ + If(debug) then Write(0,*)'Start cdovrbld',me,lworks,lworkr call psb_barrier(ictxt)