Defined min_coarse_size_per_processor and related methods and defaults.

documentation
Salvatore Filippone 4 years ago
parent 6541e3a95c
commit d644f8f76e

@ -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

@ -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')
@ -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
! casize = mncszpp*np
! Default to the cubic root of the size at base level. if (casize > huge(ione)) casize = huge(ione)
!
casize = desc_a%get_global_rows()
casize = int((sone*casize)**(sone/(sone*3)),psb_lpk_)
casize = max(casize,lone)
casize = casize*40_psb_lpk_
call psb_bcast(ctxt,casize)
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 else
prec%ag_data%min_coarse_size = casize if (mncsize < np) then
if (me == 0) write(0,*) &
& 'Warning: resetting coarse size to NP (1 variable per process)'
mncsize = np
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)
! !

@ -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

@ -125,6 +125,7 @@ subroutine amg_cprecinit(ctxt,prec,ptype,info)
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')

@ -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')
@ -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
! casize = mncszpp*np
! Default to the cubic root of the size at base level. if (casize > huge(ione)) casize = huge(ione)
!
casize = desc_a%get_global_rows()
casize = int((done*casize)**(done/(done*3)),psb_lpk_)
casize = max(casize,lone)
casize = casize*40_psb_lpk_
call psb_bcast(ctxt,casize)
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 else
prec%ag_data%min_coarse_size = casize if (mncsize < np) then
if (me == 0) write(0,*) &
& 'Warning: resetting coarse size to NP (1 variable per process)'
mncsize = np
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)
! !

@ -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

@ -128,6 +128,7 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info)
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')

@ -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')
@ -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
! casize = mncszpp*np
! Default to the cubic root of the size at base level. if (casize > huge(ione)) casize = huge(ione)
!
casize = desc_a%get_global_rows()
casize = int((sone*casize)**(sone/(sone*3)),psb_lpk_)
casize = max(casize,lone)
casize = casize*40_psb_lpk_
call psb_bcast(ctxt,casize)
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 else
prec%ag_data%min_coarse_size = casize if (mncsize < np) then
if (me == 0) write(0,*) &
& 'Warning: resetting coarse size to NP (1 variable per process)'
mncsize = np
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)
! !

@ -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

@ -125,6 +125,7 @@ subroutine amg_sprecinit(ctxt,prec,ptype,info)
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')

@ -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')
@ -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
! casize = mncszpp*np
! Default to the cubic root of the size at base level. if (casize > huge(ione)) casize = huge(ione)
!
casize = desc_a%get_global_rows()
casize = int((done*casize)**(done/(done*3)),psb_lpk_)
casize = max(casize,lone)
casize = casize*40_psb_lpk_
call psb_bcast(ctxt,casize)
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 else
prec%ag_data%min_coarse_size = casize if (mncsize < np) then
if (me == 0) write(0,*) &
& 'Warning: resetting coarse size to NP (1 variable per process)'
mncsize = np
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)
! !

@ -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

@ -128,6 +128,7 @@ subroutine amg_zprecinit(ctxt,prec,ptype,info)
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')

Loading…
Cancel
Save