From d644f8f76e48120e3029c8a089eb06027b2ae3dc Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 10 Mar 2021 09:03:24 +0100 Subject: [PATCH] Defined min_coarse_size_per_processor and related methods and defaults. --- amgprec/amg_base_prec_type.F90 | 25 ++++------ amgprec/impl/amg_c_hierarchy_bld.f90 | 70 ++++++++++++++-------------- amgprec/impl/amg_ccprecset.F90 | 3 ++ amgprec/impl/amg_cprecinit.F90 | 3 +- amgprec/impl/amg_d_hierarchy_bld.f90 | 70 ++++++++++++++-------------- amgprec/impl/amg_dcprecset.F90 | 3 ++ amgprec/impl/amg_dprecinit.F90 | 3 +- amgprec/impl/amg_s_hierarchy_bld.f90 | 70 ++++++++++++++-------------- amgprec/impl/amg_scprecset.F90 | 3 ++ amgprec/impl/amg_sprecinit.F90 | 3 +- amgprec/impl/amg_z_hierarchy_bld.f90 | 70 ++++++++++++++-------------- amgprec/impl/amg_zcprecset.F90 | 3 ++ amgprec/impl/amg_zprecinit.F90 | 3 +- 13 files changed, 174 insertions(+), 155 deletions(-) diff --git a/amgprec/amg_base_prec_type.F90 b/amgprec/amg_base_prec_type.F90 index 128683e7..ed8ffbd0 100644 --- a/amgprec/amg_base_prec_type.F90 +++ b/amgprec/amg_base_prec_type.F90 @@ -120,7 +120,9 @@ module amg_base_prec_type procedure, pass(pm) :: printout => d_ml_parms_printout end type amg_dml_parms - type amg_saggr_data + + + type amg_iaggr_data ! ! Aggregation data and defaults: ! @@ -129,28 +131,21 @@ module amg_base_prec_type ! 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 + 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 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 real(psb_spk_) :: min_cr_ratio = 1.5_psb_spk_ real(psb_spk_) :: op_complexity = szero real(psb_spk_) :: avg_cr = szero end type amg_saggr_data - type 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_ + type, extends(amg_iaggr_data) :: amg_daggr_data ! 3. min_cr_ratio = 1.5 real(psb_dpk_) :: min_cr_ratio = 1.5_psb_dpk_ real(psb_dpk_) :: op_complexity = dzero diff --git a/amgprec/impl/amg_c_hierarchy_bld.f90 b/amgprec/impl/amg_c_hierarchy_bld.f90 index d08712bf..59976527 100644 --- a/amgprec/impl/amg_c_hierarchy_bld.f90 +++ b/amgprec/impl/amg_c_hierarchy_bld.f90 @@ -72,9 +72,9 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info) Implicit None ! 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 - class(amg_cprec_type),intent(inout),target :: prec + class(amg_cprec_type),intent(inout),target :: prec integer(psb_ipk_), intent(out) :: info ! Local Variables @@ -82,7 +82,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info) integer(psb_ipk_) :: me,np integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& & nplevs, mxplevs - integer(psb_lpk_) :: iaggsize, casize + integer(psb_lpk_) :: iaggsize, casize, mncsize, mncszpp real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega class(amg_c_base_smoother_type), allocatable :: coarse_sm, med_sm, & & med_sm2, coarse_sm2 @@ -132,17 +132,24 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info) newsz = -1 mxplevs = prec%ag_data%max_levs 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) 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,mnaggratio) - if (casize /= prec%ag_data%min_coarse_size) then + if (mncsize /= prec%ag_data%min_coarse_size) then info=psb_err_internal_error_ call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') goto 9999 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 info=psb_err_internal_error_ 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_desc => desc_a - + call psb_erractionrestore(err_act) return 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 ! threshold. ! - - if (casize < 0) then - ! - ! Default to the cubic root of the size at base level. - ! - 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 - prec%ag_data%min_coarse_size = casize + if ((mncszpp < 0).and.(mncsize<0)) mncszpp = 200 + + if (mncszpp > 0) then + casize = mncszpp*np + if (casize > huge(ione)) casize = huge(ione) + else + if (mncsize < np) then + if (me == 0) write(0,*) & + & 'Warning: resetting coarse size to NP (1 variable per process)' + mncsize = np end if + casize = mncsize end if + prec%ag_data%target_coarse_size = casize + nplevs = max(itwo,mxplevs) ! @@ -248,7 +250,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info) end do deallocate(tmp_aggr,stat=info) end if - + ! Then coarse if (info == 0) tprecv(nplevs)%parms = coarseparms 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 call psb_bcast(ctxt,newsz) - + if (newsz > 0) then ! ! 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 prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_omega_val = aomega - + if (info == 0) call restore_smoothers(prec%precv(newsz),& & coarse_sm,coarse_sm2,info) 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%base_a => lv%ac lv%base_desc => lv%desc_ac - end associate + end associate end if end if @@ -525,7 +527,7 @@ contains allocate(save2, mold=level%sm2a,stat=info) if (info == 0) call level%sm2a%clone_settings(save2,info) end if - + return end subroutine save_smoothers @@ -544,9 +546,9 @@ contains if (info == 0) allocate(level%sm,mold=save1,stat=info) if (info == 0) call save1%clone_settings(level%sm,info) end if - + if (info /= 0) return - + if (allocated(level%sm2a)) then if (info == 0) call level%sm2a%free(info) if (info == 0) deallocate(level%sm2a,stat=info) @@ -560,6 +562,6 @@ contains end if return - end subroutine restore_smoothers - + end subroutine restore_smoothers + end subroutine amg_c_hierarchy_bld diff --git a/amgprec/impl/amg_ccprecset.F90 b/amgprec/impl/amg_ccprecset.F90 index 1c634877..ebf1355e 100644 --- a/amgprec/impl/amg_ccprecset.F90 +++ b/amgprec/impl/amg_ccprecset.F90 @@ -152,6 +152,9 @@ subroutine amg_ccprecseti(p,what,val,info,ilev,ilmax,pos,idx) case ('MIN_COARSE_SIZE') p%ag_data%min_coarse_size = max(val,-1) return + case ('MIN_COARSE_SIZE_PER_PROCESS') + p%ag_data%min_coarse_size_per_process = max(val,-1) + return case('MAX_LEVS') p%ag_data%max_levs = max(val,1) return diff --git a/amgprec/impl/amg_cprecinit.F90 b/amgprec/impl/amg_cprecinit.F90 index 38560a8c..4a26aba7 100644 --- a/amgprec/impl/amg_cprecinit.F90 +++ b/amgprec/impl/amg_cprecinit.F90 @@ -124,7 +124,8 @@ subroutine amg_cprecinit(ctxt,prec,ptype,info) endif endif 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))) case ('NOPREC','NONE') diff --git a/amgprec/impl/amg_d_hierarchy_bld.f90 b/amgprec/impl/amg_d_hierarchy_bld.f90 index d2069ec5..dda327a0 100644 --- a/amgprec/impl/amg_d_hierarchy_bld.f90 +++ b/amgprec/impl/amg_d_hierarchy_bld.f90 @@ -72,9 +72,9 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info) Implicit None ! 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 - class(amg_dprec_type),intent(inout),target :: prec + class(amg_dprec_type),intent(inout),target :: prec integer(psb_ipk_), intent(out) :: info ! Local Variables @@ -82,7 +82,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info) integer(psb_ipk_) :: me,np integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& & nplevs, mxplevs - integer(psb_lpk_) :: iaggsize, casize + integer(psb_lpk_) :: iaggsize, casize, mncsize, mncszpp real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega class(amg_d_base_smoother_type), allocatable :: coarse_sm, med_sm, & & med_sm2, coarse_sm2 @@ -132,17 +132,24 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info) newsz = -1 mxplevs = prec%ag_data%max_levs 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) 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,mnaggratio) - if (casize /= prec%ag_data%min_coarse_size) then + if (mncsize /= prec%ag_data%min_coarse_size) then info=psb_err_internal_error_ call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') goto 9999 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 info=psb_err_internal_error_ 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_desc => desc_a - + call psb_erractionrestore(err_act) return 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 ! threshold. ! - - if (casize < 0) then - ! - ! Default to the cubic root of the size at base level. - ! - 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 - prec%ag_data%min_coarse_size = casize + if ((mncszpp < 0).and.(mncsize<0)) mncszpp = 200 + + if (mncszpp > 0) then + casize = mncszpp*np + if (casize > huge(ione)) casize = huge(ione) + else + if (mncsize < np) then + if (me == 0) write(0,*) & + & 'Warning: resetting coarse size to NP (1 variable per process)' + mncsize = np end if + casize = mncsize end if + prec%ag_data%target_coarse_size = casize + nplevs = max(itwo,mxplevs) ! @@ -248,7 +250,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info) end do deallocate(tmp_aggr,stat=info) end if - + ! Then coarse if (info == 0) tprecv(nplevs)%parms = coarseparms 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 call psb_bcast(ctxt,newsz) - + if (newsz > 0) then ! ! 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 prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_omega_val = aomega - + if (info == 0) call restore_smoothers(prec%precv(newsz),& & coarse_sm,coarse_sm2,info) 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%base_a => lv%ac lv%base_desc => lv%desc_ac - end associate + end associate end if end if @@ -525,7 +527,7 @@ contains allocate(save2, mold=level%sm2a,stat=info) if (info == 0) call level%sm2a%clone_settings(save2,info) end if - + return end subroutine save_smoothers @@ -544,9 +546,9 @@ contains if (info == 0) allocate(level%sm,mold=save1,stat=info) if (info == 0) call save1%clone_settings(level%sm,info) end if - + if (info /= 0) return - + if (allocated(level%sm2a)) then if (info == 0) call level%sm2a%free(info) if (info == 0) deallocate(level%sm2a,stat=info) @@ -560,6 +562,6 @@ contains end if return - end subroutine restore_smoothers - + end subroutine restore_smoothers + end subroutine amg_d_hierarchy_bld diff --git a/amgprec/impl/amg_dcprecset.F90 b/amgprec/impl/amg_dcprecset.F90 index 5c4aa5e9..af44e5f5 100644 --- a/amgprec/impl/amg_dcprecset.F90 +++ b/amgprec/impl/amg_dcprecset.F90 @@ -158,6 +158,9 @@ subroutine amg_dcprecseti(p,what,val,info,ilev,ilmax,pos,idx) case ('MIN_COARSE_SIZE') p%ag_data%min_coarse_size = max(val,-1) return + case ('MIN_COARSE_SIZE_PER_PROCESS') + p%ag_data%min_coarse_size_per_process = max(val,-1) + return case('MAX_LEVS') p%ag_data%max_levs = max(val,1) return diff --git a/amgprec/impl/amg_dprecinit.F90 b/amgprec/impl/amg_dprecinit.F90 index 352966fd..99367dcb 100644 --- a/amgprec/impl/amg_dprecinit.F90 +++ b/amgprec/impl/amg_dprecinit.F90 @@ -127,7 +127,8 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info) endif endif 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))) case ('NOPREC','NONE') diff --git a/amgprec/impl/amg_s_hierarchy_bld.f90 b/amgprec/impl/amg_s_hierarchy_bld.f90 index d9c1d5d2..0a639c62 100644 --- a/amgprec/impl/amg_s_hierarchy_bld.f90 +++ b/amgprec/impl/amg_s_hierarchy_bld.f90 @@ -72,9 +72,9 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info) Implicit None ! 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 - class(amg_sprec_type),intent(inout),target :: prec + class(amg_sprec_type),intent(inout),target :: prec integer(psb_ipk_), intent(out) :: info ! Local Variables @@ -82,7 +82,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info) integer(psb_ipk_) :: me,np integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& & nplevs, mxplevs - integer(psb_lpk_) :: iaggsize, casize + integer(psb_lpk_) :: iaggsize, casize, mncsize, mncszpp real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega class(amg_s_base_smoother_type), allocatable :: coarse_sm, med_sm, & & med_sm2, coarse_sm2 @@ -132,17 +132,24 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info) newsz = -1 mxplevs = prec%ag_data%max_levs 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) 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,mnaggratio) - if (casize /= prec%ag_data%min_coarse_size) then + if (mncsize /= prec%ag_data%min_coarse_size) then info=psb_err_internal_error_ call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') goto 9999 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 info=psb_err_internal_error_ 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_desc => desc_a - + call psb_erractionrestore(err_act) return 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 ! threshold. ! - - if (casize < 0) then - ! - ! Default to the cubic root of the size at base level. - ! - 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 - prec%ag_data%min_coarse_size = casize + if ((mncszpp < 0).and.(mncsize<0)) mncszpp = 200 + + if (mncszpp > 0) then + casize = mncszpp*np + if (casize > huge(ione)) casize = huge(ione) + else + if (mncsize < np) then + if (me == 0) write(0,*) & + & 'Warning: resetting coarse size to NP (1 variable per process)' + mncsize = np end if + casize = mncsize end if + prec%ag_data%target_coarse_size = casize + nplevs = max(itwo,mxplevs) ! @@ -248,7 +250,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info) end do deallocate(tmp_aggr,stat=info) end if - + ! Then coarse if (info == 0) tprecv(nplevs)%parms = coarseparms 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 call psb_bcast(ctxt,newsz) - + if (newsz > 0) then ! ! 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 prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_omega_val = aomega - + if (info == 0) call restore_smoothers(prec%precv(newsz),& & coarse_sm,coarse_sm2,info) 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%base_a => lv%ac lv%base_desc => lv%desc_ac - end associate + end associate end if end if @@ -525,7 +527,7 @@ contains allocate(save2, mold=level%sm2a,stat=info) if (info == 0) call level%sm2a%clone_settings(save2,info) end if - + return end subroutine save_smoothers @@ -544,9 +546,9 @@ contains if (info == 0) allocate(level%sm,mold=save1,stat=info) if (info == 0) call save1%clone_settings(level%sm,info) end if - + if (info /= 0) return - + if (allocated(level%sm2a)) then if (info == 0) call level%sm2a%free(info) if (info == 0) deallocate(level%sm2a,stat=info) @@ -560,6 +562,6 @@ contains end if return - end subroutine restore_smoothers - + end subroutine restore_smoothers + end subroutine amg_s_hierarchy_bld diff --git a/amgprec/impl/amg_scprecset.F90 b/amgprec/impl/amg_scprecset.F90 index 2fd1fb29..cd8944aa 100644 --- a/amgprec/impl/amg_scprecset.F90 +++ b/amgprec/impl/amg_scprecset.F90 @@ -152,6 +152,9 @@ subroutine amg_scprecseti(p,what,val,info,ilev,ilmax,pos,idx) case ('MIN_COARSE_SIZE') p%ag_data%min_coarse_size = max(val,-1) return + case ('MIN_COARSE_SIZE_PER_PROCESS') + p%ag_data%min_coarse_size_per_process = max(val,-1) + return case('MAX_LEVS') p%ag_data%max_levs = max(val,1) return diff --git a/amgprec/impl/amg_sprecinit.F90 b/amgprec/impl/amg_sprecinit.F90 index 9ac17196..e7240c8b 100644 --- a/amgprec/impl/amg_sprecinit.F90 +++ b/amgprec/impl/amg_sprecinit.F90 @@ -124,7 +124,8 @@ subroutine amg_sprecinit(ctxt,prec,ptype,info) endif endif 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))) case ('NOPREC','NONE') diff --git a/amgprec/impl/amg_z_hierarchy_bld.f90 b/amgprec/impl/amg_z_hierarchy_bld.f90 index 5aee5d06..dacbc946 100644 --- a/amgprec/impl/amg_z_hierarchy_bld.f90 +++ b/amgprec/impl/amg_z_hierarchy_bld.f90 @@ -72,9 +72,9 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info) Implicit None ! 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 - class(amg_zprec_type),intent(inout),target :: prec + class(amg_zprec_type),intent(inout),target :: prec integer(psb_ipk_), intent(out) :: info ! Local Variables @@ -82,7 +82,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info) integer(psb_ipk_) :: me,np integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& & nplevs, mxplevs - integer(psb_lpk_) :: iaggsize, casize + integer(psb_lpk_) :: iaggsize, casize, mncsize, mncszpp real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega class(amg_z_base_smoother_type), allocatable :: coarse_sm, med_sm, & & med_sm2, coarse_sm2 @@ -132,17 +132,24 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info) newsz = -1 mxplevs = prec%ag_data%max_levs 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) 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,mnaggratio) - if (casize /= prec%ag_data%min_coarse_size) then + if (mncsize /= prec%ag_data%min_coarse_size) then info=psb_err_internal_error_ call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') goto 9999 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 info=psb_err_internal_error_ 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_desc => desc_a - + call psb_erractionrestore(err_act) return 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 ! threshold. ! - - if (casize < 0) then - ! - ! Default to the cubic root of the size at base level. - ! - 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 - prec%ag_data%min_coarse_size = casize + if ((mncszpp < 0).and.(mncsize<0)) mncszpp = 200 + + if (mncszpp > 0) then + casize = mncszpp*np + if (casize > huge(ione)) casize = huge(ione) + else + if (mncsize < np) then + if (me == 0) write(0,*) & + & 'Warning: resetting coarse size to NP (1 variable per process)' + mncsize = np end if + casize = mncsize end if + prec%ag_data%target_coarse_size = casize + nplevs = max(itwo,mxplevs) ! @@ -248,7 +250,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info) end do deallocate(tmp_aggr,stat=info) end if - + ! Then coarse if (info == 0) tprecv(nplevs)%parms = coarseparms 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 call psb_bcast(ctxt,newsz) - + if (newsz > 0) then ! ! 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 prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_omega_val = aomega - + if (info == 0) call restore_smoothers(prec%precv(newsz),& & coarse_sm,coarse_sm2,info) 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%base_a => lv%ac lv%base_desc => lv%desc_ac - end associate + end associate end if end if @@ -525,7 +527,7 @@ contains allocate(save2, mold=level%sm2a,stat=info) if (info == 0) call level%sm2a%clone_settings(save2,info) end if - + return end subroutine save_smoothers @@ -544,9 +546,9 @@ contains if (info == 0) allocate(level%sm,mold=save1,stat=info) if (info == 0) call save1%clone_settings(level%sm,info) end if - + if (info /= 0) return - + if (allocated(level%sm2a)) then if (info == 0) call level%sm2a%free(info) if (info == 0) deallocate(level%sm2a,stat=info) @@ -560,6 +562,6 @@ contains end if return - end subroutine restore_smoothers - + end subroutine restore_smoothers + end subroutine amg_z_hierarchy_bld diff --git a/amgprec/impl/amg_zcprecset.F90 b/amgprec/impl/amg_zcprecset.F90 index 5febde22..22074945 100644 --- a/amgprec/impl/amg_zcprecset.F90 +++ b/amgprec/impl/amg_zcprecset.F90 @@ -158,6 +158,9 @@ subroutine amg_zcprecseti(p,what,val,info,ilev,ilmax,pos,idx) case ('MIN_COARSE_SIZE') p%ag_data%min_coarse_size = max(val,-1) return + case ('MIN_COARSE_SIZE_PER_PROCESS') + p%ag_data%min_coarse_size_per_process = max(val,-1) + return case('MAX_LEVS') p%ag_data%max_levs = max(val,1) return diff --git a/amgprec/impl/amg_zprecinit.F90 b/amgprec/impl/amg_zprecinit.F90 index e256c750..2d4b0207 100644 --- a/amgprec/impl/amg_zprecinit.F90 +++ b/amgprec/impl/amg_zprecinit.F90 @@ -127,7 +127,8 @@ subroutine amg_zprecinit(ctxt,prec,ptype,info) endif endif 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))) case ('NOPREC','NONE')