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

Defined min_coarse_size_per_processor and related methods and defaults.

Browse Source
documentation
Salvatore Filippone 4 years ago
parent 6541e3a95c
commit d644f8f76e
13 changed files with 174 additions and 155 deletions
Show Stats Download Patch File Download Diff File

25
amgprec/amg_base_prec_type.F90
Unescape Escape View File

@ -120,7 +120,9 @@ module amg_base_prec_type
procedure, pass(pm) :: printout => d_ml_parms_printout procedure, pass(pm) :: printout => d_ml_parms_printout
end type amg_dml_parms end type amg_dml_parms
type amg_saggr_data
type amg_iaggr_data
! !
! Aggregation data and defaults: ! Aggregation data and defaults:
! !
@ -129,28 +131,21 @@ module amg_base_prec_type
! We are assuming that the coarse size fits in ! We are assuming that the coarse size fits in
! integer range of psb_ipk_, but this is ! integer range of psb_ipk_, but this is
! not very restrictive ! not very restrictive
integer(psb_ipk_) :: min_coarse_size = izero integer(psb_ipk_) :: min_coarse_size = -ione
integer(psb_ipk_) :: min_coarse_size_per_process = -ione
integer(psb_lpk_) :: target_coarse_size
! 2. maximum number of levels. Defaults to 20 ! 2. maximum number of levels. Defaults to 20
integer(psb_ipk_) :: max_levs = 20_psb_ipk_ integer(psb_ipk_) :: max_levs = 20_psb_ipk_
end type amg_iaggr_data
type, extends(amg_iaggr_data) :: amg_saggr_data
! 3. min_cr_ratio = 1.5 ! 3. min_cr_ratio = 1.5
real(psb_spk_) :: min_cr_ratio = 1.5_psb_spk_ real(psb_spk_) :: min_cr_ratio = 1.5_psb_spk_
real(psb_spk_) :: op_complexity = szero real(psb_spk_) :: op_complexity = szero
real(psb_spk_) :: avg_cr = szero real(psb_spk_) :: avg_cr = szero
end type amg_saggr_data end type amg_saggr_data
type amg_daggr_data type, extends(amg_iaggr_data) :: amg_daggr_data
!
! Aggregation data and defaults:
!
!
! 1. min_coarse_size = 0 Default target size will be computed as
! 40*(N_fine)**(1./3.)
! We are assuming that the coarse size fits in
! integer range of psb_ipk_, but this is
! not very restrictive
integer(psb_ipk_) :: min_coarse_size = izero
! 2. maximum number of levels. Defaults to 20
integer(psb_ipk_) :: max_levs = 20_psb_ipk_
! 3. min_cr_ratio = 1.5 ! 3. min_cr_ratio = 1.5
real(psb_dpk_) :: min_cr_ratio = 1.5_psb_dpk_ real(psb_dpk_) :: min_cr_ratio = 1.5_psb_dpk_
real(psb_dpk_) :: op_complexity = dzero real(psb_dpk_) :: op_complexity = dzero

70
amgprec/impl/amg_c_hierarchy_bld.f90
Unescape Escape View File

@ -72,9 +72,9 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
Implicit None Implicit None
! Arguments ! Arguments
type(psb_cspmat_type),intent(in), target :: a type(psb_cspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
class(amg_cprec_type),intent(inout),target :: prec class(amg_cprec_type),intent(inout),target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local Variables ! Local Variables
@ -82,7 +82,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_) :: me,np integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs & nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize integer(psb_lpk_) :: iaggsize, casize, mncsize, mncszpp
real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega
class(amg_c_base_smoother_type), allocatable :: coarse_sm, med_sm, & class(amg_c_base_smoother_type), allocatable :: coarse_sm, med_sm, &
& med_sm2, coarse_sm2 & med_sm2, coarse_sm2
@ -132,17 +132,24 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
newsz = -1 newsz = -1
mxplevs = prec%ag_data%max_levs mxplevs = prec%ag_data%max_levs
mnaggratio = prec%ag_data%min_cr_ratio mnaggratio = prec%ag_data%min_cr_ratio
casize = prec%ag_data%min_coarse_size mncsize = prec%ag_data%min_coarse_size
mncszpp = prec%ag_data%min_coarse_size_per_process
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ctxt,iszv) call psb_bcast(ctxt,iszv)
call psb_bcast(ctxt,casize) call psb_bcast(ctxt,mncsize)
call psb_bcast(ctxt,mncszpp)
call psb_bcast(ctxt,mxplevs) call psb_bcast(ctxt,mxplevs)
call psb_bcast(ctxt,mnaggratio) call psb_bcast(ctxt,mnaggratio)
if (casize /= prec%ag_data%min_coarse_size) then if (mncsize /= prec%ag_data%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
goto 9999 goto 9999
end if end if
if (mncszpp /= prec%ag_data%min_coarse_size_per_process) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size_per_process')
goto 9999
end if
if (mxplevs /= prec%ag_data%max_levs) then if (mxplevs /= prec%ag_data%max_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_levs') call psb_errpush(info,name,a_err='Inconsistent max_levs')
@ -175,7 +182,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
! !
prec%precv(1)%base_a => a prec%precv(1)%base_a => a
prec%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
endif endif
@ -192,26 +199,21 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
! coarse size is hit, or the gain falls below the min_cr_ratio ! coarse size is hit, or the gain falls below the min_cr_ratio
! threshold. ! threshold.
! !
if ((mncszpp < 0).and.(mncsize<0)) mncszpp = 200
if (casize < 0) then
! if (mncszpp > 0) then
! Default to the cubic root of the size at base level. casize = mncszpp*np
! if (casize > huge(ione)) casize = huge(ione)
casize = desc_a%get_global_rows() else
casize = int((sone*casize)**(sone/(sone*3)),psb_lpk_) if (mncsize < np) then
casize = max(casize,lone) if (me == 0) write(0,*) &
casize = casize*40_psb_lpk_ & 'Warning: resetting coarse size to NP (1 variable per process)'
call psb_bcast(ctxt,casize) mncsize = np
if (casize > huge(prec%ag_data%min_coarse_size)) then
!
! computed coarse size does not fit in IPK_.
! This is very unlikely, but make sure to put a positive number
!
prec%ag_data%min_coarse_size = huge(prec%ag_data%min_coarse_size)
else
prec%ag_data%min_coarse_size = casize
end if end if
casize = mncsize
end if end if
prec%ag_data%target_coarse_size = casize
nplevs = max(itwo,mxplevs) nplevs = max(itwo,mxplevs)
! !
@ -248,7 +250,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
end do end do
deallocate(tmp_aggr,stat=info) deallocate(tmp_aggr,stat=info)
end if end if
! Then coarse ! Then coarse
if (info == 0) tprecv(nplevs)%parms = coarseparms if (info == 0) tprecv(nplevs)%parms = coarseparms
if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info) if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info)
@ -369,7 +371,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
end if end if
end if end if
call psb_bcast(ctxt,newsz) call psb_bcast(ctxt,newsz)
if (newsz > 0) then if (newsz > 0) then
! !
! This is awkward, we are saving the aggregation parms, for the sake ! This is awkward, we are saving the aggregation parms, for the sake
@ -380,7 +382,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
if (info == 0) prec%precv(newsz)%parms = coarseparms if (info == 0) prec%precv(newsz)%parms = coarseparms
prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_thresh = athresh
prec%precv(newsz)%parms%aggr_omega_val = aomega prec%precv(newsz)%parms%aggr_omega_val = aomega
if (info == 0) call restore_smoothers(prec%precv(newsz),& if (info == 0) call restore_smoothers(prec%precv(newsz),&
& coarse_sm,coarse_sm2,info) & coarse_sm,coarse_sm2,info)
if (newsz < i) then if (newsz < i) then
@ -476,7 +478,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
lv%linmap%p_desc_V => rmp%desc_ac_pre_remap lv%linmap%p_desc_V => rmp%desc_ac_pre_remap
lv%base_a => lv%ac lv%base_a => lv%ac
lv%base_desc => lv%desc_ac lv%base_desc => lv%desc_ac
end associate end associate
end if end if
end if end if
@ -525,7 +527,7 @@ contains
allocate(save2, mold=level%sm2a,stat=info) allocate(save2, mold=level%sm2a,stat=info)
if (info == 0) call level%sm2a%clone_settings(save2,info) if (info == 0) call level%sm2a%clone_settings(save2,info)
end if end if
return return
end subroutine save_smoothers end subroutine save_smoothers
@ -544,9 +546,9 @@ contains
if (info == 0) allocate(level%sm,mold=save1,stat=info) if (info == 0) allocate(level%sm,mold=save1,stat=info)
if (info == 0) call save1%clone_settings(level%sm,info) if (info == 0) call save1%clone_settings(level%sm,info)
end if end if
if (info /= 0) return if (info /= 0) return
if (allocated(level%sm2a)) then if (allocated(level%sm2a)) then
if (info == 0) call level%sm2a%free(info) if (info == 0) call level%sm2a%free(info)
if (info == 0) deallocate(level%sm2a,stat=info) if (info == 0) deallocate(level%sm2a,stat=info)
@ -560,6 +562,6 @@ contains
end if end if
return return
end subroutine restore_smoothers end subroutine restore_smoothers
end subroutine amg_c_hierarchy_bld end subroutine amg_c_hierarchy_bld

3
amgprec/impl/amg_ccprecset.F90
Unescape Escape View File

@ -152,6 +152,9 @@ subroutine amg_ccprecseti(p,what,val,info,ilev,ilmax,pos,idx)
case ('MIN_COARSE_SIZE') case ('MIN_COARSE_SIZE')
p%ag_data%min_coarse_size = max(val,-1) p%ag_data%min_coarse_size = max(val,-1)
return return
case ('MIN_COARSE_SIZE_PER_PROCESS')
p%ag_data%min_coarse_size_per_process = max(val,-1)
return
case('MAX_LEVS') case('MAX_LEVS')
p%ag_data%max_levs = max(val,1) p%ag_data%max_levs = max(val,1)
return return

3
amgprec/impl/amg_cprecinit.F90
Unescape Escape View File

@ -124,7 +124,8 @@ subroutine amg_cprecinit(ctxt,prec,ptype,info)
endif endif
endif endif
prec%ctxt = ctxt prec%ctxt = ctxt
prec%ag_data%min_coarse_size = -1 prec%ag_data%min_coarse_size = -1
prec%ag_data%min_coarse_size_per_process = -1
select case(psb_toupper(trim(ptype))) select case(psb_toupper(trim(ptype)))
case ('NOPREC','NONE') case ('NOPREC','NONE')

70
amgprec/impl/amg_d_hierarchy_bld.f90
Unescape Escape View File

@ -72,9 +72,9 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
Implicit None Implicit None
! Arguments ! Arguments
type(psb_dspmat_type),intent(in), target :: a type(psb_dspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
class(amg_dprec_type),intent(inout),target :: prec class(amg_dprec_type),intent(inout),target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local Variables ! Local Variables
@ -82,7 +82,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_) :: me,np integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs & nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize integer(psb_lpk_) :: iaggsize, casize, mncsize, mncszpp
real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega
class(amg_d_base_smoother_type), allocatable :: coarse_sm, med_sm, & class(amg_d_base_smoother_type), allocatable :: coarse_sm, med_sm, &
& med_sm2, coarse_sm2 & med_sm2, coarse_sm2
@ -132,17 +132,24 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
newsz = -1 newsz = -1
mxplevs = prec%ag_data%max_levs mxplevs = prec%ag_data%max_levs
mnaggratio = prec%ag_data%min_cr_ratio mnaggratio = prec%ag_data%min_cr_ratio
casize = prec%ag_data%min_coarse_size mncsize = prec%ag_data%min_coarse_size
mncszpp = prec%ag_data%min_coarse_size_per_process
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ctxt,iszv) call psb_bcast(ctxt,iszv)
call psb_bcast(ctxt,casize) call psb_bcast(ctxt,mncsize)
call psb_bcast(ctxt,mncszpp)
call psb_bcast(ctxt,mxplevs) call psb_bcast(ctxt,mxplevs)
call psb_bcast(ctxt,mnaggratio) call psb_bcast(ctxt,mnaggratio)
if (casize /= prec%ag_data%min_coarse_size) then if (mncsize /= prec%ag_data%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
goto 9999 goto 9999
end if end if
if (mncszpp /= prec%ag_data%min_coarse_size_per_process) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size_per_process')
goto 9999
end if
if (mxplevs /= prec%ag_data%max_levs) then if (mxplevs /= prec%ag_data%max_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_levs') call psb_errpush(info,name,a_err='Inconsistent max_levs')
@ -175,7 +182,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
! !
prec%precv(1)%base_a => a prec%precv(1)%base_a => a
prec%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
endif endif
@ -192,26 +199,21 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
! coarse size is hit, or the gain falls below the min_cr_ratio ! coarse size is hit, or the gain falls below the min_cr_ratio
! threshold. ! threshold.
! !
if ((mncszpp < 0).and.(mncsize<0)) mncszpp = 200
if (casize < 0) then
! if (mncszpp > 0) then
! Default to the cubic root of the size at base level. casize = mncszpp*np
! if (casize > huge(ione)) casize = huge(ione)
casize = desc_a%get_global_rows() else
casize = int((done*casize)**(done/(done*3)),psb_lpk_) if (mncsize < np) then
casize = max(casize,lone) if (me == 0) write(0,*) &
casize = casize*40_psb_lpk_ & 'Warning: resetting coarse size to NP (1 variable per process)'
call psb_bcast(ctxt,casize) mncsize = np
if (casize > huge(prec%ag_data%min_coarse_size)) then
!
! computed coarse size does not fit in IPK_.
! This is very unlikely, but make sure to put a positive number
!
prec%ag_data%min_coarse_size = huge(prec%ag_data%min_coarse_size)
else
prec%ag_data%min_coarse_size = casize
end if end if
casize = mncsize
end if end if
prec%ag_data%target_coarse_size = casize
nplevs = max(itwo,mxplevs) nplevs = max(itwo,mxplevs)
! !
@ -248,7 +250,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
end do end do
deallocate(tmp_aggr,stat=info) deallocate(tmp_aggr,stat=info)
end if end if
! Then coarse ! Then coarse
if (info == 0) tprecv(nplevs)%parms = coarseparms if (info == 0) tprecv(nplevs)%parms = coarseparms
if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info) if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info)
@ -369,7 +371,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
end if end if
end if end if
call psb_bcast(ctxt,newsz) call psb_bcast(ctxt,newsz)
if (newsz > 0) then if (newsz > 0) then
! !
! This is awkward, we are saving the aggregation parms, for the sake ! This is awkward, we are saving the aggregation parms, for the sake
@ -380,7 +382,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
if (info == 0) prec%precv(newsz)%parms = coarseparms if (info == 0) prec%precv(newsz)%parms = coarseparms
prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_thresh = athresh
prec%precv(newsz)%parms%aggr_omega_val = aomega prec%precv(newsz)%parms%aggr_omega_val = aomega
if (info == 0) call restore_smoothers(prec%precv(newsz),& if (info == 0) call restore_smoothers(prec%precv(newsz),&
& coarse_sm,coarse_sm2,info) & coarse_sm,coarse_sm2,info)
if (newsz < i) then if (newsz < i) then
@ -476,7 +478,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
lv%linmap%p_desc_V => rmp%desc_ac_pre_remap lv%linmap%p_desc_V => rmp%desc_ac_pre_remap
lv%base_a => lv%ac lv%base_a => lv%ac
lv%base_desc => lv%desc_ac lv%base_desc => lv%desc_ac
end associate end associate
end if end if
end if end if
@ -525,7 +527,7 @@ contains
allocate(save2, mold=level%sm2a,stat=info) allocate(save2, mold=level%sm2a,stat=info)
if (info == 0) call level%sm2a%clone_settings(save2,info) if (info == 0) call level%sm2a%clone_settings(save2,info)
end if end if
return return
end subroutine save_smoothers end subroutine save_smoothers
@ -544,9 +546,9 @@ contains
if (info == 0) allocate(level%sm,mold=save1,stat=info) if (info == 0) allocate(level%sm,mold=save1,stat=info)
if (info == 0) call save1%clone_settings(level%sm,info) if (info == 0) call save1%clone_settings(level%sm,info)
end if end if
if (info /= 0) return if (info /= 0) return
if (allocated(level%sm2a)) then if (allocated(level%sm2a)) then
if (info == 0) call level%sm2a%free(info) if (info == 0) call level%sm2a%free(info)
if (info == 0) deallocate(level%sm2a,stat=info) if (info == 0) deallocate(level%sm2a,stat=info)
@ -560,6 +562,6 @@ contains
end if end if
return return
end subroutine restore_smoothers end subroutine restore_smoothers
end subroutine amg_d_hierarchy_bld end subroutine amg_d_hierarchy_bld

3
amgprec/impl/amg_dcprecset.F90
Unescape Escape View File

@ -158,6 +158,9 @@ subroutine amg_dcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
case ('MIN_COARSE_SIZE') case ('MIN_COARSE_SIZE')
p%ag_data%min_coarse_size = max(val,-1) p%ag_data%min_coarse_size = max(val,-1)
return return
case ('MIN_COARSE_SIZE_PER_PROCESS')
p%ag_data%min_coarse_size_per_process = max(val,-1)
return
case('MAX_LEVS') case('MAX_LEVS')
p%ag_data%max_levs = max(val,1) p%ag_data%max_levs = max(val,1)
return return

3
amgprec/impl/amg_dprecinit.F90
Unescape Escape View File

@ -127,7 +127,8 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info)
endif endif
endif endif
prec%ctxt = ctxt prec%ctxt = ctxt
prec%ag_data%min_coarse_size = -1 prec%ag_data%min_coarse_size = -1
prec%ag_data%min_coarse_size_per_process = -1
select case(psb_toupper(trim(ptype))) select case(psb_toupper(trim(ptype)))
case ('NOPREC','NONE') case ('NOPREC','NONE')

70
amgprec/impl/amg_s_hierarchy_bld.f90
Unescape Escape View File

@ -72,9 +72,9 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
Implicit None Implicit None
! Arguments ! Arguments
type(psb_sspmat_type),intent(in), target :: a type(psb_sspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
class(amg_sprec_type),intent(inout),target :: prec class(amg_sprec_type),intent(inout),target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local Variables ! Local Variables
@ -82,7 +82,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_) :: me,np integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs & nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize integer(psb_lpk_) :: iaggsize, casize, mncsize, mncszpp
real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega
class(amg_s_base_smoother_type), allocatable :: coarse_sm, med_sm, & class(amg_s_base_smoother_type), allocatable :: coarse_sm, med_sm, &
& med_sm2, coarse_sm2 & med_sm2, coarse_sm2
@ -132,17 +132,24 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
newsz = -1 newsz = -1
mxplevs = prec%ag_data%max_levs mxplevs = prec%ag_data%max_levs
mnaggratio = prec%ag_data%min_cr_ratio mnaggratio = prec%ag_data%min_cr_ratio
casize = prec%ag_data%min_coarse_size mncsize = prec%ag_data%min_coarse_size
mncszpp = prec%ag_data%min_coarse_size_per_process
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ctxt,iszv) call psb_bcast(ctxt,iszv)
call psb_bcast(ctxt,casize) call psb_bcast(ctxt,mncsize)
call psb_bcast(ctxt,mncszpp)
call psb_bcast(ctxt,mxplevs) call psb_bcast(ctxt,mxplevs)
call psb_bcast(ctxt,mnaggratio) call psb_bcast(ctxt,mnaggratio)
if (casize /= prec%ag_data%min_coarse_size) then if (mncsize /= prec%ag_data%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
goto 9999 goto 9999
end if end if
if (mncszpp /= prec%ag_data%min_coarse_size_per_process) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size_per_process')
goto 9999
end if
if (mxplevs /= prec%ag_data%max_levs) then if (mxplevs /= prec%ag_data%max_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_levs') call psb_errpush(info,name,a_err='Inconsistent max_levs')
@ -175,7 +182,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
! !
prec%precv(1)%base_a => a prec%precv(1)%base_a => a
prec%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
endif endif
@ -192,26 +199,21 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
! coarse size is hit, or the gain falls below the min_cr_ratio ! coarse size is hit, or the gain falls below the min_cr_ratio
! threshold. ! threshold.
! !
if ((mncszpp < 0).and.(mncsize<0)) mncszpp = 200
if (casize < 0) then
! if (mncszpp > 0) then
! Default to the cubic root of the size at base level. casize = mncszpp*np
! if (casize > huge(ione)) casize = huge(ione)
casize = desc_a%get_global_rows() else
casize = int((sone*casize)**(sone/(sone*3)),psb_lpk_) if (mncsize < np) then
casize = max(casize,lone) if (me == 0) write(0,*) &
casize = casize*40_psb_lpk_ & 'Warning: resetting coarse size to NP (1 variable per process)'
call psb_bcast(ctxt,casize) mncsize = np
if (casize > huge(prec%ag_data%min_coarse_size)) then
!
! computed coarse size does not fit in IPK_.
! This is very unlikely, but make sure to put a positive number
!
prec%ag_data%min_coarse_size = huge(prec%ag_data%min_coarse_size)
else
prec%ag_data%min_coarse_size = casize
end if end if
casize = mncsize
end if end if
prec%ag_data%target_coarse_size = casize
nplevs = max(itwo,mxplevs) nplevs = max(itwo,mxplevs)
! !
@ -248,7 +250,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
end do end do
deallocate(tmp_aggr,stat=info) deallocate(tmp_aggr,stat=info)
end if end if
! Then coarse ! Then coarse
if (info == 0) tprecv(nplevs)%parms = coarseparms if (info == 0) tprecv(nplevs)%parms = coarseparms
if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info) if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info)
@ -369,7 +371,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
end if end if
end if end if
call psb_bcast(ctxt,newsz) call psb_bcast(ctxt,newsz)
if (newsz > 0) then if (newsz > 0) then
! !
! This is awkward, we are saving the aggregation parms, for the sake ! This is awkward, we are saving the aggregation parms, for the sake
@ -380,7 +382,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
if (info == 0) prec%precv(newsz)%parms = coarseparms if (info == 0) prec%precv(newsz)%parms = coarseparms
prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_thresh = athresh
prec%precv(newsz)%parms%aggr_omega_val = aomega prec%precv(newsz)%parms%aggr_omega_val = aomega
if (info == 0) call restore_smoothers(prec%precv(newsz),& if (info == 0) call restore_smoothers(prec%precv(newsz),&
& coarse_sm,coarse_sm2,info) & coarse_sm,coarse_sm2,info)
if (newsz < i) then if (newsz < i) then
@ -476,7 +478,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
lv%linmap%p_desc_V => rmp%desc_ac_pre_remap lv%linmap%p_desc_V => rmp%desc_ac_pre_remap
lv%base_a => lv%ac lv%base_a => lv%ac
lv%base_desc => lv%desc_ac lv%base_desc => lv%desc_ac
end associate end associate
end if end if
end if end if
@ -525,7 +527,7 @@ contains
allocate(save2, mold=level%sm2a,stat=info) allocate(save2, mold=level%sm2a,stat=info)
if (info == 0) call level%sm2a%clone_settings(save2,info) if (info == 0) call level%sm2a%clone_settings(save2,info)
end if end if
return return
end subroutine save_smoothers end subroutine save_smoothers
@ -544,9 +546,9 @@ contains
if (info == 0) allocate(level%sm,mold=save1,stat=info) if (info == 0) allocate(level%sm,mold=save1,stat=info)
if (info == 0) call save1%clone_settings(level%sm,info) if (info == 0) call save1%clone_settings(level%sm,info)
end if end if
if (info /= 0) return if (info /= 0) return
if (allocated(level%sm2a)) then if (allocated(level%sm2a)) then
if (info == 0) call level%sm2a%free(info) if (info == 0) call level%sm2a%free(info)
if (info == 0) deallocate(level%sm2a,stat=info) if (info == 0) deallocate(level%sm2a,stat=info)
@ -560,6 +562,6 @@ contains
end if end if
return return
end subroutine restore_smoothers end subroutine restore_smoothers
end subroutine amg_s_hierarchy_bld end subroutine amg_s_hierarchy_bld

3
amgprec/impl/amg_scprecset.F90
Unescape Escape View File

@ -152,6 +152,9 @@ subroutine amg_scprecseti(p,what,val,info,ilev,ilmax,pos,idx)
case ('MIN_COARSE_SIZE') case ('MIN_COARSE_SIZE')
p%ag_data%min_coarse_size = max(val,-1) p%ag_data%min_coarse_size = max(val,-1)
return return
case ('MIN_COARSE_SIZE_PER_PROCESS')
p%ag_data%min_coarse_size_per_process = max(val,-1)
return
case('MAX_LEVS') case('MAX_LEVS')
p%ag_data%max_levs = max(val,1) p%ag_data%max_levs = max(val,1)
return return

3
amgprec/impl/amg_sprecinit.F90
Unescape Escape View File

@ -124,7 +124,8 @@ subroutine amg_sprecinit(ctxt,prec,ptype,info)
endif endif
endif endif
prec%ctxt = ctxt prec%ctxt = ctxt
prec%ag_data%min_coarse_size = -1 prec%ag_data%min_coarse_size = -1
prec%ag_data%min_coarse_size_per_process = -1
select case(psb_toupper(trim(ptype))) select case(psb_toupper(trim(ptype)))
case ('NOPREC','NONE') case ('NOPREC','NONE')

70
amgprec/impl/amg_z_hierarchy_bld.f90
Unescape Escape View File

@ -72,9 +72,9 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
Implicit None Implicit None
! Arguments ! Arguments
type(psb_zspmat_type),intent(in), target :: a type(psb_zspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
class(amg_zprec_type),intent(inout),target :: prec class(amg_zprec_type),intent(inout),target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local Variables ! Local Variables
@ -82,7 +82,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_) :: me,np integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs & nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize integer(psb_lpk_) :: iaggsize, casize, mncsize, mncszpp
real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega
class(amg_z_base_smoother_type), allocatable :: coarse_sm, med_sm, & class(amg_z_base_smoother_type), allocatable :: coarse_sm, med_sm, &
& med_sm2, coarse_sm2 & med_sm2, coarse_sm2
@ -132,17 +132,24 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
newsz = -1 newsz = -1
mxplevs = prec%ag_data%max_levs mxplevs = prec%ag_data%max_levs
mnaggratio = prec%ag_data%min_cr_ratio mnaggratio = prec%ag_data%min_cr_ratio
casize = prec%ag_data%min_coarse_size mncsize = prec%ag_data%min_coarse_size
mncszpp = prec%ag_data%min_coarse_size_per_process
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ctxt,iszv) call psb_bcast(ctxt,iszv)
call psb_bcast(ctxt,casize) call psb_bcast(ctxt,mncsize)
call psb_bcast(ctxt,mncszpp)
call psb_bcast(ctxt,mxplevs) call psb_bcast(ctxt,mxplevs)
call psb_bcast(ctxt,mnaggratio) call psb_bcast(ctxt,mnaggratio)
if (casize /= prec%ag_data%min_coarse_size) then if (mncsize /= prec%ag_data%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
goto 9999 goto 9999
end if end if
if (mncszpp /= prec%ag_data%min_coarse_size_per_process) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size_per_process')
goto 9999
end if
if (mxplevs /= prec%ag_data%max_levs) then if (mxplevs /= prec%ag_data%max_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_levs') call psb_errpush(info,name,a_err='Inconsistent max_levs')
@ -175,7 +182,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
! !
prec%precv(1)%base_a => a prec%precv(1)%base_a => a
prec%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
endif endif
@ -192,26 +199,21 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
! coarse size is hit, or the gain falls below the min_cr_ratio ! coarse size is hit, or the gain falls below the min_cr_ratio
! threshold. ! threshold.
! !
if ((mncszpp < 0).and.(mncsize<0)) mncszpp = 200
if (casize < 0) then
! if (mncszpp > 0) then
! Default to the cubic root of the size at base level. casize = mncszpp*np
! if (casize > huge(ione)) casize = huge(ione)
casize = desc_a%get_global_rows() else
casize = int((done*casize)**(done/(done*3)),psb_lpk_) if (mncsize < np) then
casize = max(casize,lone) if (me == 0) write(0,*) &
casize = casize*40_psb_lpk_ & 'Warning: resetting coarse size to NP (1 variable per process)'
call psb_bcast(ctxt,casize) mncsize = np
if (casize > huge(prec%ag_data%min_coarse_size)) then
!
! computed coarse size does not fit in IPK_.
! This is very unlikely, but make sure to put a positive number
!
prec%ag_data%min_coarse_size = huge(prec%ag_data%min_coarse_size)
else
prec%ag_data%min_coarse_size = casize
end if end if
casize = mncsize
end if end if
prec%ag_data%target_coarse_size = casize
nplevs = max(itwo,mxplevs) nplevs = max(itwo,mxplevs)
! !
@ -248,7 +250,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
end do end do
deallocate(tmp_aggr,stat=info) deallocate(tmp_aggr,stat=info)
end if end if
! Then coarse ! Then coarse
if (info == 0) tprecv(nplevs)%parms = coarseparms if (info == 0) tprecv(nplevs)%parms = coarseparms
if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info) if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info)
@ -369,7 +371,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
end if end if
end if end if
call psb_bcast(ctxt,newsz) call psb_bcast(ctxt,newsz)
if (newsz > 0) then if (newsz > 0) then
! !
! This is awkward, we are saving the aggregation parms, for the sake ! This is awkward, we are saving the aggregation parms, for the sake
@ -380,7 +382,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
if (info == 0) prec%precv(newsz)%parms = coarseparms if (info == 0) prec%precv(newsz)%parms = coarseparms
prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_thresh = athresh
prec%precv(newsz)%parms%aggr_omega_val = aomega prec%precv(newsz)%parms%aggr_omega_val = aomega
if (info == 0) call restore_smoothers(prec%precv(newsz),& if (info == 0) call restore_smoothers(prec%precv(newsz),&
& coarse_sm,coarse_sm2,info) & coarse_sm,coarse_sm2,info)
if (newsz < i) then if (newsz < i) then
@ -476,7 +478,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
lv%linmap%p_desc_V => rmp%desc_ac_pre_remap lv%linmap%p_desc_V => rmp%desc_ac_pre_remap
lv%base_a => lv%ac lv%base_a => lv%ac
lv%base_desc => lv%desc_ac lv%base_desc => lv%desc_ac
end associate end associate
end if end if
end if end if
@ -525,7 +527,7 @@ contains
allocate(save2, mold=level%sm2a,stat=info) allocate(save2, mold=level%sm2a,stat=info)
if (info == 0) call level%sm2a%clone_settings(save2,info) if (info == 0) call level%sm2a%clone_settings(save2,info)
end if end if
return return
end subroutine save_smoothers end subroutine save_smoothers
@ -544,9 +546,9 @@ contains
if (info == 0) allocate(level%sm,mold=save1,stat=info) if (info == 0) allocate(level%sm,mold=save1,stat=info)
if (info == 0) call save1%clone_settings(level%sm,info) if (info == 0) call save1%clone_settings(level%sm,info)
end if end if
if (info /= 0) return if (info /= 0) return
if (allocated(level%sm2a)) then if (allocated(level%sm2a)) then
if (info == 0) call level%sm2a%free(info) if (info == 0) call level%sm2a%free(info)
if (info == 0) deallocate(level%sm2a,stat=info) if (info == 0) deallocate(level%sm2a,stat=info)
@ -560,6 +562,6 @@ contains
end if end if
return return
end subroutine restore_smoothers end subroutine restore_smoothers
end subroutine amg_z_hierarchy_bld end subroutine amg_z_hierarchy_bld

3
amgprec/impl/amg_zcprecset.F90
Unescape Escape View File

@ -158,6 +158,9 @@ subroutine amg_zcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
case ('MIN_COARSE_SIZE') case ('MIN_COARSE_SIZE')
p%ag_data%min_coarse_size = max(val,-1) p%ag_data%min_coarse_size = max(val,-1)
return return
case ('MIN_COARSE_SIZE_PER_PROCESS')
p%ag_data%min_coarse_size_per_process = max(val,-1)
return
case('MAX_LEVS') case('MAX_LEVS')
p%ag_data%max_levs = max(val,1) p%ag_data%max_levs = max(val,1)
return return

3
amgprec/impl/amg_zprecinit.F90
Unescape Escape View File

@ -127,7 +127,8 @@ subroutine amg_zprecinit(ctxt,prec,ptype,info)
endif endif
endif endif
prec%ctxt = ctxt prec%ctxt = ctxt
prec%ag_data%min_coarse_size = -1 prec%ag_data%min_coarse_size = -1
prec%ag_data%min_coarse_size_per_process = -1
select case(psb_toupper(trim(ptype))) select case(psb_toupper(trim(ptype)))
case ('NOPREC','NONE') case ('NOPREC','NONE')

Write Preview
Loading…
Cancel
Save