diff --git a/mlprec/impl/mld_c_bld_mlhier_aggsize.f90 b/mlprec/impl/mld_c_bld_mlhier_aggsize.f90 index fde2d1a1..f968245e 100644 --- a/mlprec/impl/mld_c_bld_mlhier_aggsize.f90 +++ b/mlprec/impl/mld_c_bld_mlhier_aggsize.f90 @@ -40,27 +40,28 @@ ! Build an aggregation hierarchy with a target aggregation size ! ! -subroutine mld_c_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) +subroutine mld_c_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info) use psb_base_mod use mld_c_inner_mod, mld_protect_name => mld_c_bld_mlhier_aggsize use mld_c_prec_mod implicit none - integer(psb_ipk_), intent(in) :: casize - integer(psb_ipk_), intent(inout) :: iszv + integer(psb_ipk_), intent(in) :: casize,mxplevs + real(psb_spk_) :: mnaggratio type(psb_cspmat_type),intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a type(mld_c_onelev_type), allocatable, target, intent(inout) :: precv(:) integer(psb_ipk_), intent(out) :: info ! Local - integer(psb_ipk_) :: ictxt, me,np - integer(psb_ipk_) :: err,i,k, err_act, newsz - integer(psb_ipk_) :: ipv(mld_ifpsz_), val - integer(psb_ipk_) :: int_err(5) - character :: upd_ + integer(psb_ipk_) :: ictxt, me,np + integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, iaggsize + integer(psb_ipk_) :: ipv(mld_ifpsz_), val + integer(psb_ipk_) :: int_err(5) + character :: upd_ class(mld_c_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm - type(mld_sml_parms) :: baseparms, medparms, coarseparms + type(mld_sml_parms) :: baseparms, medparms, coarseparms type(mld_c_onelev_node), pointer :: head, tail, newnode, current - integer(psb_ipk_) :: debug_level, debug_unit + real(psb_spk_) :: sizeratio + integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err name = 'mld_bld_mlhier_aggsize' if (psb_get_errstatus().ne.0) return @@ -74,6 +75,7 @@ subroutine mld_c_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) ! ! New strategy to build according to coarse size. ! + iszv = size(precv) coarseparms = precv(iszv)%parms baseparms = precv(1)%parms medparms = precv(2)%parms @@ -126,13 +128,27 @@ subroutine mld_c_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) call psb_errpush(info,name,a_err='build next level'); goto 9999 end if - if (newsz>2) then - if (all(current%item%map%naggr == newnode%item%map%naggr)) then + current => current%next + tail => current + iaggsize = sum(current%item%map%naggr) + + if (iaggsize <= casize) then + ! + ! Target reached; but we may need to rebuild. + ! + exit list_build_loop + end if + if (newsz>2) then + sizeratio = iaggsize + sizeratio = sum(current%prev%item%map%naggr)/sizeratio + + if (sizeratio < mnaggratio) then ! - ! We are not gaining anything + ! We are not gaining ! newsz = newsz-1 - current%next => null() + current => current%prev + current%next =>null() call newnode%item%free(info) if (info == psb_success_) deallocate(newnode,stat=info) if (info /= psb_success_) then @@ -143,14 +159,6 @@ subroutine mld_c_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) end if end if - current => current%next - tail => current - if (sum(current%item%map%naggr) <= casize) then - ! - ! Target reached; but we may need to rebuild. - ! - exit list_build_loop - end if end do list_build_loop ! ! At this point, we are at the list tail, diff --git a/mlprec/impl/mld_c_bld_mlhier_array.f90 b/mlprec/impl/mld_c_bld_mlhier_array.f90 index 226973de..5cdabd24 100644 --- a/mlprec/impl/mld_c_bld_mlhier_array.f90 +++ b/mlprec/impl/mld_c_bld_mlhier_array.f90 @@ -37,20 +37,22 @@ !!$ !!$ -subroutine mld_c_bld_mlhier_array(a,desc_a,iszv,precv,info) +subroutine mld_c_bld_mlhier_array(nplevs,a,desc_a,precv,info) use psb_base_mod use mld_c_inner_mod, mld_protect_name => mld_c_bld_mlhier_array use mld_c_prec_mod implicit none - integer(psb_ipk_), intent(inout) :: iszv + integer(psb_ipk_), intent(inout) :: nplevs type(psb_cspmat_type),intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a type(mld_c_onelev_type),intent(inout), allocatable, target :: precv(:) integer(psb_ipk_), intent(out) :: info ! Local integer(psb_ipk_) :: ictxt, me,np - integer(psb_ipk_) :: err,i,k, err_act, newsz + integer(psb_ipk_) :: err,i,k, err_act, newsz, iszv integer(psb_ipk_) :: ipv(mld_ifpsz_), val + class(mld_c_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm + type(mld_sml_parms) :: baseparms, medparms, coarseparms type(mld_c_onelev_type), allocatable :: tprecv(:) integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: debug_level, debug_unit @@ -64,6 +66,22 @@ subroutine mld_c_bld_mlhier_array(a,desc_a,iszv,precv,info) debug_level = psb_get_debug_level() ictxt = desc_a%get_ctxt() call psb_info(ictxt,me,np) + iszv = size(precv) + + coarseparms = precv(iszv)%parms + baseparms = precv(1)%parms + medparms = precv(2)%parms + + allocate(coarse_sm, source=precv(iszv)%sm,stat=info) + if (info == psb_success_) & + & allocate(med_sm, source=precv(2)%sm,stat=info) + if (info == psb_success_) & + & allocate(base_sm, source=precv(1)%sm,stat=info) + if (info /= psb_success_) then + write(0,*) 'Error in saving smoothers',info + call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') + goto 9999 + end if ! ! @@ -75,12 +93,52 @@ subroutine mld_c_bld_mlhier_array(a,desc_a,iszv,precv,info) ! on all processes. ! call psb_bcast(ictxt,precv(1)%parms) + iszv = size(precv) + ! + ! First set desired number of levels + ! + if (iszv /= nplevs) then + allocate(tprecv(nplevs),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + tprecv(1)%parms = baseparms + allocate(tprecv(1)%sm,source=base_sm,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + do i=2,nplevs-1 + tprecv(i)%parms = medparms + allocate(tprecv(i)%sm,source=med_sm,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + end do + tprecv(nplevs)%parms = coarseparms + allocate(tprecv(nplevs)%sm,source=coarse_sm,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + do i=1,iszv + call precv(i)%free(info) + end do + call move_alloc(tprecv,precv) + iszv = size(precv) + end if + ! ! Finest level first; remember to fix base_a and base_desc ! precv(1)%base_a => a precv(1)%base_desc => desc_a - iszv = size(precv) array_build_loop: do i=2, iszv ! diff --git a/mlprec/impl/mld_ccprecset.F90 b/mlprec/impl/mld_ccprecset.F90 index 86b1b413..6f627992 100644 --- a/mlprec/impl/mld_ccprecset.F90 +++ b/mlprec/impl/mld_ccprecset.F90 @@ -132,10 +132,20 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,pos) return endif - if (psb_toupper(what) == 'COARSE_AGGR_SIZE') then + + select case(psb_toupper(what)) + case ('COARSE_AGGR_SIZE') p%coarse_aggr_size = max(val,-1) return - end if + case ('N_PREC_LEVS') + p%n_prec_levs = max(val,1) + return + case('MAX_PREC_LEVS') + p%max_prec_levs = max(val,1) + return + end select + + ! ! Set preconditioner parameters at level ilev. ! @@ -465,6 +475,12 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev,pos) else ilev_ = 1 end if + + select case(psb_toupper(what)) + case ('MIN_AGGR_RATIO') + p%min_aggr_ratio = max(sone,val) + return + end select if (.not.allocated(p%precv)) then write(psb_err_unit,*) name,& diff --git a/mlprec/impl/mld_cmlprec_bld.f90 b/mlprec/impl/mld_cmlprec_bld.f90 index 4521b09d..b7cdc637 100644 --- a/mlprec/impl/mld_cmlprec_bld.f90 +++ b/mlprec/impl/mld_cmlprec_bld.f90 @@ -93,12 +93,13 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold) !!$ character, intent(in), optional :: upd ! Local Variables - integer(psb_ipk_) :: ictxt, me,np - integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize - integer(psb_ipk_) :: ipv(mld_ifpsz_), val - integer(psb_ipk_) :: int_err(5) - character :: upd_ - integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_) :: ictxt, me,np + integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs + real(psb_spk_) :: mnaggratio + integer(psb_ipk_) :: ipv(mld_ifpsz_), val + integer(psb_ipk_) :: int_err(5) + character :: upd_ + integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err if (psb_get_errstatus().ne.0) return @@ -144,23 +145,42 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold) ! ! Check to ensure all procs have the same ! - newsz = -1 - casize = p%coarse_aggr_size - iszv = size(p%precv) + newsz = -1 + casize = p%coarse_aggr_size + nplevs = p%n_prec_levs + mxplevs = p%max_prec_levs + mnaggratio = p%min_aggr_ratio + casize = p%coarse_aggr_size + iszv = size(p%precv) call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,casize) - if (casize > 0) then - if (casize /= p%coarse_aggr_size) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') - goto 9999 - end if - else - if (iszv /= size(p%precv)) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='Inconsistent size of precv') - goto 9999 - end if + call psb_bcast(ictxt,nplevs) + call psb_bcast(ictxt,mxplevs) + call psb_bcast(ictxt,mnaggratio) + if (casize /= p%coarse_aggr_size) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') + goto 9999 + end if + if (nplevs /= p%n_prec_levs) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent n_prec_levs') + goto 9999 + end if + if (mxplevs /= p%max_prec_levs) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') + goto 9999 + end if + if (mnaggratio /= p%min_aggr_ratio) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') + goto 9999 + end if + if (iszv /= size(p%precv)) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent size of precv') + goto 9999 end if if (iszv <= 1) then @@ -171,20 +191,27 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold) goto 9999 endif - - - if (casize>0) then + if (nplevs <= 0) then ! ! This should become the default strategy, we specify a target aggregation size. ! - call mld_bld_mlhier_aggsize(casize,a,desc_a,iszv,p%precv,info) + 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_ipk_) + casize = max(casize,ione) + end if + call mld_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,p%precv,info) else ! ! Oldstyle with fixed number of levels. ! - call mld_bld_mlhier_array(a,desc_a,p%precv,info) + nplevs = max(itwo,min(nplevs,mxplevs)) + call mld_bld_mlhier_array(nplevs,a,desc_a,p%precv,info) end if - + iszv = size(p%precv) ! diff --git a/mlprec/impl/mld_cprecinit.F90 b/mlprec/impl/mld_cprecinit.F90 index b1347ea7..8027c9e5 100644 --- a/mlprec/impl/mld_cprecinit.F90 +++ b/mlprec/impl/mld_cprecinit.F90 @@ -165,9 +165,11 @@ subroutine mld_cprecinit(p,ptype,info,nlev) case ('ML') if (present(nlev)) then - nlev_ = max(1,nlev) + nlev_ = max(1,nlev) + p%n_prec_levs = nlev_ else - nlev_ = 2 + nlev_ = 3 + p%n_prec_levs = -ione end if ilev_ = 1 allocate(p%precv(nlev_),stat=info) diff --git a/mlprec/impl/mld_cprecset.F90 b/mlprec/impl/mld_cprecset.F90 index 4b12a7e1..4eefe7f0 100644 --- a/mlprec/impl/mld_cprecset.F90 +++ b/mlprec/impl/mld_cprecset.F90 @@ -131,10 +131,18 @@ subroutine mld_cprecseti(p,what,val,info,ilev,pos) return endif - if (what == mld_coarse_aggr_size_) then + + select case(what) + case (mld_coarse_aggr_size_) p%coarse_aggr_size = max(val,-1) return - end if + case (mld_n_prec_levs_) + p%n_prec_levs = max(val,1) + return + case(mld_max_prec_levs_) + p%max_prec_levs = max(val,1) + return + end select ! ! Set preconditioner parameters at level ilev. @@ -564,6 +572,12 @@ subroutine mld_cprecsetr(p,what,val,info,ilev,pos) info = psb_success_ + select case(what) + case (mld_min_aggr_ratio_) + p%min_aggr_ratio = max(sone,val) + return + end select + if (present(ilev)) then ilev_ = ilev else diff --git a/mlprec/impl/mld_d_bld_mlhier_aggsize.f90 b/mlprec/impl/mld_d_bld_mlhier_aggsize.f90 index 14b413cd..0004f073 100644 --- a/mlprec/impl/mld_d_bld_mlhier_aggsize.f90 +++ b/mlprec/impl/mld_d_bld_mlhier_aggsize.f90 @@ -40,27 +40,28 @@ ! Build an aggregation hierarchy with a target aggregation size ! ! -subroutine mld_d_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) +subroutine mld_d_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info) use psb_base_mod use mld_d_inner_mod, mld_protect_name => mld_d_bld_mlhier_aggsize use mld_d_prec_mod implicit none - integer(psb_ipk_), intent(in) :: casize - integer(psb_ipk_), intent(inout) :: iszv + integer(psb_ipk_), intent(in) :: casize,mxplevs + real(psb_dpk_) :: mnaggratio type(psb_dspmat_type),intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a type(mld_d_onelev_type), allocatable, target, intent(inout) :: precv(:) integer(psb_ipk_), intent(out) :: info ! Local - integer(psb_ipk_) :: ictxt, me,np - integer(psb_ipk_) :: err,i,k, err_act, newsz - integer(psb_ipk_) :: ipv(mld_ifpsz_), val - integer(psb_ipk_) :: int_err(5) - character :: upd_ + integer(psb_ipk_) :: ictxt, me,np + integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, iaggsize + integer(psb_ipk_) :: ipv(mld_ifpsz_), val + integer(psb_ipk_) :: int_err(5) + character :: upd_ class(mld_d_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm - type(mld_dml_parms) :: baseparms, medparms, coarseparms + type(mld_dml_parms) :: baseparms, medparms, coarseparms type(mld_d_onelev_node), pointer :: head, tail, newnode, current - integer(psb_ipk_) :: debug_level, debug_unit + real(psb_dpk_) :: sizeratio + integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err name = 'mld_bld_mlhier_aggsize' if (psb_get_errstatus().ne.0) return @@ -74,6 +75,7 @@ subroutine mld_d_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) ! ! New strategy to build according to coarse size. ! + iszv = size(precv) coarseparms = precv(iszv)%parms baseparms = precv(1)%parms medparms = precv(2)%parms @@ -126,13 +128,27 @@ subroutine mld_d_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) call psb_errpush(info,name,a_err='build next level'); goto 9999 end if - if (newsz>2) then - if (all(current%item%map%naggr == newnode%item%map%naggr)) then + current => current%next + tail => current + iaggsize = sum(current%item%map%naggr) + + if (iaggsize <= casize) then + ! + ! Target reached; but we may need to rebuild. + ! + exit list_build_loop + end if + if (newsz>2) then + sizeratio = iaggsize + sizeratio = sum(current%prev%item%map%naggr)/sizeratio + + if (sizeratio < mnaggratio) then ! - ! We are not gaining anything + ! We are not gaining ! newsz = newsz-1 - current%next => null() + current => current%prev + current%next =>null() call newnode%item%free(info) if (info == psb_success_) deallocate(newnode,stat=info) if (info /= psb_success_) then @@ -143,14 +159,6 @@ subroutine mld_d_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) end if end if - current => current%next - tail => current - if (sum(current%item%map%naggr) <= casize) then - ! - ! Target reached; but we may need to rebuild. - ! - exit list_build_loop - end if end do list_build_loop ! ! At this point, we are at the list tail, diff --git a/mlprec/impl/mld_d_bld_mlhier_array.f90 b/mlprec/impl/mld_d_bld_mlhier_array.f90 index bb091540..73002567 100644 --- a/mlprec/impl/mld_d_bld_mlhier_array.f90 +++ b/mlprec/impl/mld_d_bld_mlhier_array.f90 @@ -37,20 +37,22 @@ !!$ !!$ -subroutine mld_d_bld_mlhier_array(a,desc_a,iszv,precv,info) +subroutine mld_d_bld_mlhier_array(nplevs,a,desc_a,precv,info) use psb_base_mod use mld_d_inner_mod, mld_protect_name => mld_d_bld_mlhier_array use mld_d_prec_mod implicit none - integer(psb_ipk_), intent(inout) :: iszv + integer(psb_ipk_), intent(inout) :: nplevs type(psb_dspmat_type),intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a type(mld_d_onelev_type),intent(inout), allocatable, target :: precv(:) integer(psb_ipk_), intent(out) :: info ! Local integer(psb_ipk_) :: ictxt, me,np - integer(psb_ipk_) :: err,i,k, err_act, newsz + integer(psb_ipk_) :: err,i,k, err_act, newsz, iszv integer(psb_ipk_) :: ipv(mld_ifpsz_), val + class(mld_d_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm + type(mld_dml_parms) :: baseparms, medparms, coarseparms type(mld_d_onelev_type), allocatable :: tprecv(:) integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: debug_level, debug_unit @@ -64,6 +66,22 @@ subroutine mld_d_bld_mlhier_array(a,desc_a,iszv,precv,info) debug_level = psb_get_debug_level() ictxt = desc_a%get_ctxt() call psb_info(ictxt,me,np) + iszv = size(precv) + + coarseparms = precv(iszv)%parms + baseparms = precv(1)%parms + medparms = precv(2)%parms + + allocate(coarse_sm, source=precv(iszv)%sm,stat=info) + if (info == psb_success_) & + & allocate(med_sm, source=precv(2)%sm,stat=info) + if (info == psb_success_) & + & allocate(base_sm, source=precv(1)%sm,stat=info) + if (info /= psb_success_) then + write(0,*) 'Error in saving smoothers',info + call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') + goto 9999 + end if ! ! @@ -75,12 +93,52 @@ subroutine mld_d_bld_mlhier_array(a,desc_a,iszv,precv,info) ! on all processes. ! call psb_bcast(ictxt,precv(1)%parms) + iszv = size(precv) + ! + ! First set desired number of levels + ! + if (iszv /= nplevs) then + allocate(tprecv(nplevs),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + tprecv(1)%parms = baseparms + allocate(tprecv(1)%sm,source=base_sm,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + do i=2,nplevs-1 + tprecv(i)%parms = medparms + allocate(tprecv(i)%sm,source=med_sm,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + end do + tprecv(nplevs)%parms = coarseparms + allocate(tprecv(nplevs)%sm,source=coarse_sm,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + do i=1,iszv + call precv(i)%free(info) + end do + call move_alloc(tprecv,precv) + iszv = size(precv) + end if + ! ! Finest level first; remember to fix base_a and base_desc ! precv(1)%base_a => a precv(1)%base_desc => desc_a - iszv = size(precv) array_build_loop: do i=2, iszv ! diff --git a/mlprec/impl/mld_dcprecset.F90 b/mlprec/impl/mld_dcprecset.F90 index ab02ed09..feff56e4 100644 --- a/mlprec/impl/mld_dcprecset.F90 +++ b/mlprec/impl/mld_dcprecset.F90 @@ -138,10 +138,20 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,pos) return endif - if (psb_toupper(what) == 'COARSE_AGGR_SIZE') then + + select case(psb_toupper(what)) + case ('COARSE_AGGR_SIZE') p%coarse_aggr_size = max(val,-1) return - end if + case ('N_PREC_LEVS') + p%n_prec_levs = max(val,1) + return + case('MAX_PREC_LEVS') + p%max_prec_levs = max(val,1) + return + end select + + ! ! Set preconditioner parameters at level ilev. ! @@ -475,6 +485,12 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev,pos) else ilev_ = 1 end if + + select case(psb_toupper(what)) + case ('MIN_AGGR_RATIO') + p%min_aggr_ratio = max(done,val) + return + end select if (.not.allocated(p%precv)) then write(psb_err_unit,*) name,& diff --git a/mlprec/impl/mld_dmlprec_bld.f90 b/mlprec/impl/mld_dmlprec_bld.f90 index 94894ce6..81e257bc 100644 --- a/mlprec/impl/mld_dmlprec_bld.f90 +++ b/mlprec/impl/mld_dmlprec_bld.f90 @@ -93,12 +93,13 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold) !!$ character, intent(in), optional :: upd ! Local Variables - integer(psb_ipk_) :: ictxt, me,np - integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize - integer(psb_ipk_) :: ipv(mld_ifpsz_), val - integer(psb_ipk_) :: int_err(5) - character :: upd_ - integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_) :: ictxt, me,np + integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs + real(psb_dpk_) :: mnaggratio + integer(psb_ipk_) :: ipv(mld_ifpsz_), val + integer(psb_ipk_) :: int_err(5) + character :: upd_ + integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err if (psb_get_errstatus().ne.0) return @@ -144,23 +145,42 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold) ! ! Check to ensure all procs have the same ! - newsz = -1 - casize = p%coarse_aggr_size - iszv = size(p%precv) + newsz = -1 + casize = p%coarse_aggr_size + nplevs = p%n_prec_levs + mxplevs = p%max_prec_levs + mnaggratio = p%min_aggr_ratio + casize = p%coarse_aggr_size + iszv = size(p%precv) call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,casize) - if (casize > 0) then - if (casize /= p%coarse_aggr_size) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') - goto 9999 - end if - else - if (iszv /= size(p%precv)) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='Inconsistent size of precv') - goto 9999 - end if + call psb_bcast(ictxt,nplevs) + call psb_bcast(ictxt,mxplevs) + call psb_bcast(ictxt,mnaggratio) + if (casize /= p%coarse_aggr_size) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') + goto 9999 + end if + if (nplevs /= p%n_prec_levs) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent n_prec_levs') + goto 9999 + end if + if (mxplevs /= p%max_prec_levs) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') + goto 9999 + end if + if (mnaggratio /= p%min_aggr_ratio) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') + goto 9999 + end if + if (iszv /= size(p%precv)) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent size of precv') + goto 9999 end if if (iszv <= 1) then @@ -171,20 +191,27 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold) goto 9999 endif - - - if (casize>0) then + if (nplevs <= 0) then ! ! This should become the default strategy, we specify a target aggregation size. ! - call mld_bld_mlhier_aggsize(casize,a,desc_a,iszv,p%precv,info) + 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_ipk_) + casize = max(casize,ione) + end if + call mld_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,p%precv,info) else ! ! Oldstyle with fixed number of levels. ! - call mld_bld_mlhier_array(a,desc_a,p%precv,info) + nplevs = max(itwo,min(nplevs,mxplevs)) + call mld_bld_mlhier_array(nplevs,a,desc_a,p%precv,info) end if - + iszv = size(p%precv) ! diff --git a/mlprec/impl/mld_dprecinit.F90 b/mlprec/impl/mld_dprecinit.F90 index 86be5b05..883957bb 100644 --- a/mlprec/impl/mld_dprecinit.F90 +++ b/mlprec/impl/mld_dprecinit.F90 @@ -168,9 +168,11 @@ subroutine mld_dprecinit(p,ptype,info,nlev) case ('ML') if (present(nlev)) then - nlev_ = max(1,nlev) + nlev_ = max(1,nlev) + !p%n_prec_levs = nlev_ else - nlev_ = 2 + nlev_ = 3 + !p%n_prec_levs = -ione end if ilev_ = 1 allocate(p%precv(nlev_),stat=info) diff --git a/mlprec/impl/mld_dprecset.F90 b/mlprec/impl/mld_dprecset.F90 index cb1c50df..4991806c 100644 --- a/mlprec/impl/mld_dprecset.F90 +++ b/mlprec/impl/mld_dprecset.F90 @@ -137,10 +137,18 @@ subroutine mld_dprecseti(p,what,val,info,ilev,pos) return endif - if (what == mld_coarse_aggr_size_) then + + select case(what) + case (mld_coarse_aggr_size_) p%coarse_aggr_size = max(val,-1) return - end if + case (mld_n_prec_levs_) + p%n_prec_levs = max(val,1) + return + case(mld_max_prec_levs_) + p%max_prec_levs = max(val,1) + return + end select ! ! Set preconditioner parameters at level ilev. @@ -574,6 +582,12 @@ subroutine mld_dprecsetr(p,what,val,info,ilev,pos) info = psb_success_ + select case(what) + case (mld_min_aggr_ratio_) + p%min_aggr_ratio = max(done,val) + return + end select + if (present(ilev)) then ilev_ = ilev else diff --git a/mlprec/impl/mld_s_bld_mlhier_aggsize.f90 b/mlprec/impl/mld_s_bld_mlhier_aggsize.f90 index f655155a..e3c412b1 100644 --- a/mlprec/impl/mld_s_bld_mlhier_aggsize.f90 +++ b/mlprec/impl/mld_s_bld_mlhier_aggsize.f90 @@ -40,27 +40,28 @@ ! Build an aggregation hierarchy with a target aggregation size ! ! -subroutine mld_s_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) +subroutine mld_s_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info) use psb_base_mod use mld_s_inner_mod, mld_protect_name => mld_s_bld_mlhier_aggsize use mld_s_prec_mod implicit none - integer(psb_ipk_), intent(in) :: casize - integer(psb_ipk_), intent(inout) :: iszv + integer(psb_ipk_), intent(in) :: casize,mxplevs + real(psb_spk_) :: mnaggratio type(psb_sspmat_type),intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a type(mld_s_onelev_type), allocatable, target, intent(inout) :: precv(:) integer(psb_ipk_), intent(out) :: info ! Local - integer(psb_ipk_) :: ictxt, me,np - integer(psb_ipk_) :: err,i,k, err_act, newsz - integer(psb_ipk_) :: ipv(mld_ifpsz_), val - integer(psb_ipk_) :: int_err(5) - character :: upd_ + integer(psb_ipk_) :: ictxt, me,np + integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, iaggsize + integer(psb_ipk_) :: ipv(mld_ifpsz_), val + integer(psb_ipk_) :: int_err(5) + character :: upd_ class(mld_s_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm - type(mld_sml_parms) :: baseparms, medparms, coarseparms + type(mld_sml_parms) :: baseparms, medparms, coarseparms type(mld_s_onelev_node), pointer :: head, tail, newnode, current - integer(psb_ipk_) :: debug_level, debug_unit + real(psb_spk_) :: sizeratio + integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err name = 'mld_bld_mlhier_aggsize' if (psb_get_errstatus().ne.0) return @@ -74,6 +75,7 @@ subroutine mld_s_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) ! ! New strategy to build according to coarse size. ! + iszv = size(precv) coarseparms = precv(iszv)%parms baseparms = precv(1)%parms medparms = precv(2)%parms @@ -126,13 +128,27 @@ subroutine mld_s_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) call psb_errpush(info,name,a_err='build next level'); goto 9999 end if - if (newsz>2) then - if (all(current%item%map%naggr == newnode%item%map%naggr)) then + current => current%next + tail => current + iaggsize = sum(current%item%map%naggr) + + if (iaggsize <= casize) then + ! + ! Target reached; but we may need to rebuild. + ! + exit list_build_loop + end if + if (newsz>2) then + sizeratio = iaggsize + sizeratio = sum(current%prev%item%map%naggr)/sizeratio + + if (sizeratio < mnaggratio) then ! - ! We are not gaining anything + ! We are not gaining ! newsz = newsz-1 - current%next => null() + current => current%prev + current%next =>null() call newnode%item%free(info) if (info == psb_success_) deallocate(newnode,stat=info) if (info /= psb_success_) then @@ -143,14 +159,6 @@ subroutine mld_s_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) end if end if - current => current%next - tail => current - if (sum(current%item%map%naggr) <= casize) then - ! - ! Target reached; but we may need to rebuild. - ! - exit list_build_loop - end if end do list_build_loop ! ! At this point, we are at the list tail, diff --git a/mlprec/impl/mld_s_bld_mlhier_array.f90 b/mlprec/impl/mld_s_bld_mlhier_array.f90 index fd4864ce..9a516028 100644 --- a/mlprec/impl/mld_s_bld_mlhier_array.f90 +++ b/mlprec/impl/mld_s_bld_mlhier_array.f90 @@ -37,20 +37,22 @@ !!$ !!$ -subroutine mld_s_bld_mlhier_array(a,desc_a,iszv,precv,info) +subroutine mld_s_bld_mlhier_array(nplevs,a,desc_a,precv,info) use psb_base_mod use mld_s_inner_mod, mld_protect_name => mld_s_bld_mlhier_array use mld_s_prec_mod implicit none - integer(psb_ipk_), intent(inout) :: iszv + integer(psb_ipk_), intent(inout) :: nplevs type(psb_sspmat_type),intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a type(mld_s_onelev_type),intent(inout), allocatable, target :: precv(:) integer(psb_ipk_), intent(out) :: info ! Local integer(psb_ipk_) :: ictxt, me,np - integer(psb_ipk_) :: err,i,k, err_act, newsz + integer(psb_ipk_) :: err,i,k, err_act, newsz, iszv integer(psb_ipk_) :: ipv(mld_ifpsz_), val + class(mld_s_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm + type(mld_sml_parms) :: baseparms, medparms, coarseparms type(mld_s_onelev_type), allocatable :: tprecv(:) integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: debug_level, debug_unit @@ -64,6 +66,22 @@ subroutine mld_s_bld_mlhier_array(a,desc_a,iszv,precv,info) debug_level = psb_get_debug_level() ictxt = desc_a%get_ctxt() call psb_info(ictxt,me,np) + iszv = size(precv) + + coarseparms = precv(iszv)%parms + baseparms = precv(1)%parms + medparms = precv(2)%parms + + allocate(coarse_sm, source=precv(iszv)%sm,stat=info) + if (info == psb_success_) & + & allocate(med_sm, source=precv(2)%sm,stat=info) + if (info == psb_success_) & + & allocate(base_sm, source=precv(1)%sm,stat=info) + if (info /= psb_success_) then + write(0,*) 'Error in saving smoothers',info + call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') + goto 9999 + end if ! ! @@ -75,12 +93,52 @@ subroutine mld_s_bld_mlhier_array(a,desc_a,iszv,precv,info) ! on all processes. ! call psb_bcast(ictxt,precv(1)%parms) + iszv = size(precv) + ! + ! First set desired number of levels + ! + if (iszv /= nplevs) then + allocate(tprecv(nplevs),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + tprecv(1)%parms = baseparms + allocate(tprecv(1)%sm,source=base_sm,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + do i=2,nplevs-1 + tprecv(i)%parms = medparms + allocate(tprecv(i)%sm,source=med_sm,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + end do + tprecv(nplevs)%parms = coarseparms + allocate(tprecv(nplevs)%sm,source=coarse_sm,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + do i=1,iszv + call precv(i)%free(info) + end do + call move_alloc(tprecv,precv) + iszv = size(precv) + end if + ! ! Finest level first; remember to fix base_a and base_desc ! precv(1)%base_a => a precv(1)%base_desc => desc_a - iszv = size(precv) array_build_loop: do i=2, iszv ! diff --git a/mlprec/impl/mld_scprecset.F90 b/mlprec/impl/mld_scprecset.F90 index 70889de8..c39839fb 100644 --- a/mlprec/impl/mld_scprecset.F90 +++ b/mlprec/impl/mld_scprecset.F90 @@ -132,10 +132,20 @@ subroutine mld_scprecseti(p,what,val,info,ilev,pos) return endif - if (psb_toupper(what) == 'COARSE_AGGR_SIZE') then + + select case(psb_toupper(what)) + case ('COARSE_AGGR_SIZE') p%coarse_aggr_size = max(val,-1) return - end if + case ('N_PREC_LEVS') + p%n_prec_levs = max(val,1) + return + case('MAX_PREC_LEVS') + p%max_prec_levs = max(val,1) + return + end select + + ! ! Set preconditioner parameters at level ilev. ! @@ -465,6 +475,12 @@ subroutine mld_scprecsetr(p,what,val,info,ilev,pos) else ilev_ = 1 end if + + select case(psb_toupper(what)) + case ('MIN_AGGR_RATIO') + p%min_aggr_ratio = max(sone,val) + return + end select if (.not.allocated(p%precv)) then write(psb_err_unit,*) name,& diff --git a/mlprec/impl/mld_smlprec_bld.f90 b/mlprec/impl/mld_smlprec_bld.f90 index 78a159f1..9025bb12 100644 --- a/mlprec/impl/mld_smlprec_bld.f90 +++ b/mlprec/impl/mld_smlprec_bld.f90 @@ -93,12 +93,13 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold) !!$ character, intent(in), optional :: upd ! Local Variables - integer(psb_ipk_) :: ictxt, me,np - integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize - integer(psb_ipk_) :: ipv(mld_ifpsz_), val - integer(psb_ipk_) :: int_err(5) - character :: upd_ - integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_) :: ictxt, me,np + integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs + real(psb_spk_) :: mnaggratio + integer(psb_ipk_) :: ipv(mld_ifpsz_), val + integer(psb_ipk_) :: int_err(5) + character :: upd_ + integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err if (psb_get_errstatus().ne.0) return @@ -144,23 +145,42 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold) ! ! Check to ensure all procs have the same ! - newsz = -1 - casize = p%coarse_aggr_size - iszv = size(p%precv) + newsz = -1 + casize = p%coarse_aggr_size + nplevs = p%n_prec_levs + mxplevs = p%max_prec_levs + mnaggratio = p%min_aggr_ratio + casize = p%coarse_aggr_size + iszv = size(p%precv) call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,casize) - if (casize > 0) then - if (casize /= p%coarse_aggr_size) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') - goto 9999 - end if - else - if (iszv /= size(p%precv)) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='Inconsistent size of precv') - goto 9999 - end if + call psb_bcast(ictxt,nplevs) + call psb_bcast(ictxt,mxplevs) + call psb_bcast(ictxt,mnaggratio) + if (casize /= p%coarse_aggr_size) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') + goto 9999 + end if + if (nplevs /= p%n_prec_levs) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent n_prec_levs') + goto 9999 + end if + if (mxplevs /= p%max_prec_levs) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') + goto 9999 + end if + if (mnaggratio /= p%min_aggr_ratio) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') + goto 9999 + end if + if (iszv /= size(p%precv)) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent size of precv') + goto 9999 end if if (iszv <= 1) then @@ -171,20 +191,27 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold) goto 9999 endif - - - if (casize>0) then + if (nplevs <= 0) then ! ! This should become the default strategy, we specify a target aggregation size. ! - call mld_bld_mlhier_aggsize(casize,a,desc_a,iszv,p%precv,info) + 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_ipk_) + casize = max(casize,ione) + end if + call mld_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,p%precv,info) else ! ! Oldstyle with fixed number of levels. ! - call mld_bld_mlhier_array(a,desc_a,p%precv,info) + nplevs = max(itwo,min(nplevs,mxplevs)) + call mld_bld_mlhier_array(nplevs,a,desc_a,p%precv,info) end if - + iszv = size(p%precv) ! diff --git a/mlprec/impl/mld_sprecinit.F90 b/mlprec/impl/mld_sprecinit.F90 index 24021e6d..16ee4351 100644 --- a/mlprec/impl/mld_sprecinit.F90 +++ b/mlprec/impl/mld_sprecinit.F90 @@ -165,9 +165,11 @@ subroutine mld_sprecinit(p,ptype,info,nlev) case ('ML') if (present(nlev)) then - nlev_ = max(1,nlev) + nlev_ = max(1,nlev) + p%n_prec_levs = nlev_ else - nlev_ = 2 + nlev_ = 3 + p%n_prec_levs = -ione end if ilev_ = 1 allocate(p%precv(nlev_),stat=info) diff --git a/mlprec/impl/mld_sprecset.F90 b/mlprec/impl/mld_sprecset.F90 index 22da5c01..d9400333 100644 --- a/mlprec/impl/mld_sprecset.F90 +++ b/mlprec/impl/mld_sprecset.F90 @@ -131,10 +131,18 @@ subroutine mld_sprecseti(p,what,val,info,ilev,pos) return endif - if (what == mld_coarse_aggr_size_) then + + select case(what) + case (mld_coarse_aggr_size_) p%coarse_aggr_size = max(val,-1) return - end if + case (mld_n_prec_levs_) + p%n_prec_levs = max(val,1) + return + case(mld_max_prec_levs_) + p%max_prec_levs = max(val,1) + return + end select ! ! Set preconditioner parameters at level ilev. @@ -564,6 +572,12 @@ subroutine mld_sprecsetr(p,what,val,info,ilev,pos) info = psb_success_ + select case(what) + case (mld_min_aggr_ratio_) + p%min_aggr_ratio = max(sone,val) + return + end select + if (present(ilev)) then ilev_ = ilev else diff --git a/mlprec/impl/mld_z_bld_mlhier_aggsize.f90 b/mlprec/impl/mld_z_bld_mlhier_aggsize.f90 index cce4d6e0..4ca37459 100644 --- a/mlprec/impl/mld_z_bld_mlhier_aggsize.f90 +++ b/mlprec/impl/mld_z_bld_mlhier_aggsize.f90 @@ -40,27 +40,28 @@ ! Build an aggregation hierarchy with a target aggregation size ! ! -subroutine mld_z_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) +subroutine mld_z_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info) use psb_base_mod use mld_z_inner_mod, mld_protect_name => mld_z_bld_mlhier_aggsize use mld_z_prec_mod implicit none - integer(psb_ipk_), intent(in) :: casize - integer(psb_ipk_), intent(inout) :: iszv + integer(psb_ipk_), intent(in) :: casize,mxplevs + real(psb_dpk_) :: mnaggratio type(psb_zspmat_type),intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a type(mld_z_onelev_type), allocatable, target, intent(inout) :: precv(:) integer(psb_ipk_), intent(out) :: info ! Local - integer(psb_ipk_) :: ictxt, me,np - integer(psb_ipk_) :: err,i,k, err_act, newsz - integer(psb_ipk_) :: ipv(mld_ifpsz_), val - integer(psb_ipk_) :: int_err(5) - character :: upd_ + integer(psb_ipk_) :: ictxt, me,np + integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, iaggsize + integer(psb_ipk_) :: ipv(mld_ifpsz_), val + integer(psb_ipk_) :: int_err(5) + character :: upd_ class(mld_z_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm - type(mld_dml_parms) :: baseparms, medparms, coarseparms + type(mld_dml_parms) :: baseparms, medparms, coarseparms type(mld_z_onelev_node), pointer :: head, tail, newnode, current - integer(psb_ipk_) :: debug_level, debug_unit + real(psb_dpk_) :: sizeratio + integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err name = 'mld_bld_mlhier_aggsize' if (psb_get_errstatus().ne.0) return @@ -74,6 +75,7 @@ subroutine mld_z_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) ! ! New strategy to build according to coarse size. ! + iszv = size(precv) coarseparms = precv(iszv)%parms baseparms = precv(1)%parms medparms = precv(2)%parms @@ -126,13 +128,27 @@ subroutine mld_z_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) call psb_errpush(info,name,a_err='build next level'); goto 9999 end if - if (newsz>2) then - if (all(current%item%map%naggr == newnode%item%map%naggr)) then + current => current%next + tail => current + iaggsize = sum(current%item%map%naggr) + + if (iaggsize <= casize) then + ! + ! Target reached; but we may need to rebuild. + ! + exit list_build_loop + end if + if (newsz>2) then + sizeratio = iaggsize + sizeratio = sum(current%prev%item%map%naggr)/sizeratio + + if (sizeratio < mnaggratio) then ! - ! We are not gaining anything + ! We are not gaining ! newsz = newsz-1 - current%next => null() + current => current%prev + current%next =>null() call newnode%item%free(info) if (info == psb_success_) deallocate(newnode,stat=info) if (info /= psb_success_) then @@ -143,14 +159,6 @@ subroutine mld_z_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) end if end if - current => current%next - tail => current - if (sum(current%item%map%naggr) <= casize) then - ! - ! Target reached; but we may need to rebuild. - ! - exit list_build_loop - end if end do list_build_loop ! ! At this point, we are at the list tail, diff --git a/mlprec/impl/mld_z_bld_mlhier_array.f90 b/mlprec/impl/mld_z_bld_mlhier_array.f90 index 7c84d857..b8a20df4 100644 --- a/mlprec/impl/mld_z_bld_mlhier_array.f90 +++ b/mlprec/impl/mld_z_bld_mlhier_array.f90 @@ -37,20 +37,22 @@ !!$ !!$ -subroutine mld_z_bld_mlhier_array(a,desc_a,iszv,precv,info) +subroutine mld_z_bld_mlhier_array(nplevs,a,desc_a,precv,info) use psb_base_mod use mld_z_inner_mod, mld_protect_name => mld_z_bld_mlhier_array use mld_z_prec_mod implicit none - integer(psb_ipk_), intent(inout) :: iszv + integer(psb_ipk_), intent(inout) :: nplevs type(psb_zspmat_type),intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a type(mld_z_onelev_type),intent(inout), allocatable, target :: precv(:) integer(psb_ipk_), intent(out) :: info ! Local integer(psb_ipk_) :: ictxt, me,np - integer(psb_ipk_) :: err,i,k, err_act, newsz + integer(psb_ipk_) :: err,i,k, err_act, newsz, iszv integer(psb_ipk_) :: ipv(mld_ifpsz_), val + class(mld_z_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm + type(mld_dml_parms) :: baseparms, medparms, coarseparms type(mld_z_onelev_type), allocatable :: tprecv(:) integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: debug_level, debug_unit @@ -64,6 +66,22 @@ subroutine mld_z_bld_mlhier_array(a,desc_a,iszv,precv,info) debug_level = psb_get_debug_level() ictxt = desc_a%get_ctxt() call psb_info(ictxt,me,np) + iszv = size(precv) + + coarseparms = precv(iszv)%parms + baseparms = precv(1)%parms + medparms = precv(2)%parms + + allocate(coarse_sm, source=precv(iszv)%sm,stat=info) + if (info == psb_success_) & + & allocate(med_sm, source=precv(2)%sm,stat=info) + if (info == psb_success_) & + & allocate(base_sm, source=precv(1)%sm,stat=info) + if (info /= psb_success_) then + write(0,*) 'Error in saving smoothers',info + call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') + goto 9999 + end if ! ! @@ -75,12 +93,52 @@ subroutine mld_z_bld_mlhier_array(a,desc_a,iszv,precv,info) ! on all processes. ! call psb_bcast(ictxt,precv(1)%parms) + iszv = size(precv) + ! + ! First set desired number of levels + ! + if (iszv /= nplevs) then + allocate(tprecv(nplevs),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + tprecv(1)%parms = baseparms + allocate(tprecv(1)%sm,source=base_sm,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + do i=2,nplevs-1 + tprecv(i)%parms = medparms + allocate(tprecv(i)%sm,source=med_sm,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + end do + tprecv(nplevs)%parms = coarseparms + allocate(tprecv(nplevs)%sm,source=coarse_sm,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='prec reallocation') + goto 9999 + endif + do i=1,iszv + call precv(i)%free(info) + end do + call move_alloc(tprecv,precv) + iszv = size(precv) + end if + ! ! Finest level first; remember to fix base_a and base_desc ! precv(1)%base_a => a precv(1)%base_desc => desc_a - iszv = size(precv) array_build_loop: do i=2, iszv ! diff --git a/mlprec/impl/mld_zcprecset.F90 b/mlprec/impl/mld_zcprecset.F90 index e73b0d86..b2aba3df 100644 --- a/mlprec/impl/mld_zcprecset.F90 +++ b/mlprec/impl/mld_zcprecset.F90 @@ -138,10 +138,20 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,pos) return endif - if (psb_toupper(what) == 'COARSE_AGGR_SIZE') then + + select case(psb_toupper(what)) + case ('COARSE_AGGR_SIZE') p%coarse_aggr_size = max(val,-1) return - end if + case ('N_PREC_LEVS') + p%n_prec_levs = max(val,1) + return + case('MAX_PREC_LEVS') + p%max_prec_levs = max(val,1) + return + end select + + ! ! Set preconditioner parameters at level ilev. ! @@ -475,6 +485,12 @@ subroutine mld_zcprecsetr(p,what,val,info,ilev,pos) else ilev_ = 1 end if + + select case(psb_toupper(what)) + case ('MIN_AGGR_RATIO') + p%min_aggr_ratio = max(done,val) + return + end select if (.not.allocated(p%precv)) then write(psb_err_unit,*) name,& diff --git a/mlprec/impl/mld_zmlprec_bld.f90 b/mlprec/impl/mld_zmlprec_bld.f90 index f31bbf3c..8aab68c2 100644 --- a/mlprec/impl/mld_zmlprec_bld.f90 +++ b/mlprec/impl/mld_zmlprec_bld.f90 @@ -93,12 +93,13 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold) !!$ character, intent(in), optional :: upd ! Local Variables - integer(psb_ipk_) :: ictxt, me,np - integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize - integer(psb_ipk_) :: ipv(mld_ifpsz_), val - integer(psb_ipk_) :: int_err(5) - character :: upd_ - integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_) :: ictxt, me,np + integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs + real(psb_dpk_) :: mnaggratio + integer(psb_ipk_) :: ipv(mld_ifpsz_), val + integer(psb_ipk_) :: int_err(5) + character :: upd_ + integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err if (psb_get_errstatus().ne.0) return @@ -144,23 +145,42 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold) ! ! Check to ensure all procs have the same ! - newsz = -1 - casize = p%coarse_aggr_size - iszv = size(p%precv) + newsz = -1 + casize = p%coarse_aggr_size + nplevs = p%n_prec_levs + mxplevs = p%max_prec_levs + mnaggratio = p%min_aggr_ratio + casize = p%coarse_aggr_size + iszv = size(p%precv) call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,casize) - if (casize > 0) then - if (casize /= p%coarse_aggr_size) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') - goto 9999 - end if - else - if (iszv /= size(p%precv)) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='Inconsistent size of precv') - goto 9999 - end if + call psb_bcast(ictxt,nplevs) + call psb_bcast(ictxt,mxplevs) + call psb_bcast(ictxt,mnaggratio) + if (casize /= p%coarse_aggr_size) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') + goto 9999 + end if + if (nplevs /= p%n_prec_levs) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent n_prec_levs') + goto 9999 + end if + if (mxplevs /= p%max_prec_levs) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') + goto 9999 + end if + if (mnaggratio /= p%min_aggr_ratio) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') + goto 9999 + end if + if (iszv /= size(p%precv)) then + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Inconsistent size of precv') + goto 9999 end if if (iszv <= 1) then @@ -171,20 +191,27 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold) goto 9999 endif - - - if (casize>0) then + if (nplevs <= 0) then ! ! This should become the default strategy, we specify a target aggregation size. ! - call mld_bld_mlhier_aggsize(casize,a,desc_a,iszv,p%precv,info) + 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_ipk_) + casize = max(casize,ione) + end if + call mld_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,p%precv,info) else ! ! Oldstyle with fixed number of levels. ! - call mld_bld_mlhier_array(a,desc_a,p%precv,info) + nplevs = max(itwo,min(nplevs,mxplevs)) + call mld_bld_mlhier_array(nplevs,a,desc_a,p%precv,info) end if - + iszv = size(p%precv) ! diff --git a/mlprec/impl/mld_zprecinit.F90 b/mlprec/impl/mld_zprecinit.F90 index fa0f9337..b10c38fc 100644 --- a/mlprec/impl/mld_zprecinit.F90 +++ b/mlprec/impl/mld_zprecinit.F90 @@ -168,9 +168,11 @@ subroutine mld_zprecinit(p,ptype,info,nlev) case ('ML') if (present(nlev)) then - nlev_ = max(1,nlev) + nlev_ = max(1,nlev) + p%n_prec_levs = nlev_ else - nlev_ = 2 + nlev_ = 3 + p%n_prec_levs = -ione end if ilev_ = 1 allocate(p%precv(nlev_),stat=info) diff --git a/mlprec/impl/mld_zprecset.F90 b/mlprec/impl/mld_zprecset.F90 index 29aa699c..a4cd4fef 100644 --- a/mlprec/impl/mld_zprecset.F90 +++ b/mlprec/impl/mld_zprecset.F90 @@ -137,10 +137,18 @@ subroutine mld_zprecseti(p,what,val,info,ilev,pos) return endif - if (what == mld_coarse_aggr_size_) then + + select case(what) + case (mld_coarse_aggr_size_) p%coarse_aggr_size = max(val,-1) return - end if + case (mld_n_prec_levs_) + p%n_prec_levs = max(val,1) + return + case(mld_max_prec_levs_) + p%max_prec_levs = max(val,1) + return + end select ! ! Set preconditioner parameters at level ilev. @@ -574,6 +582,12 @@ subroutine mld_zprecsetr(p,what,val,info,ilev,pos) info = psb_success_ + select case(what) + case (mld_min_aggr_ratio_) + p%min_aggr_ratio = max(done,val) + return + end select + if (present(ilev)) then ilev_ = ilev else diff --git a/mlprec/mld_base_prec_type.F90 b/mlprec/mld_base_prec_type.F90 index 5e4619c8..8dac161d 100644 --- a/mlprec/mld_base_prec_type.F90 +++ b/mlprec/mld_base_prec_type.F90 @@ -161,9 +161,12 @@ module mld_base_prec_type integer(psb_ipk_), parameter :: mld_coarse_fillin_ = 33 integer(psb_ipk_), parameter :: mld_coarse_subsolve_ = 34 integer(psb_ipk_), parameter :: mld_smoother_sweeps_ = 35 - integer(psb_ipk_), parameter :: mld_coarse_aggr_size_ = 36 - integer(psb_ipk_), parameter :: mld_solver_sweeps_ = 37 - integer(psb_ipk_), parameter :: mld_ifpsz_ = 38 + integer(psb_ipk_), parameter :: mld_solver_sweeps_ = 36 + integer(psb_ipk_), parameter :: mld_coarse_aggr_size_ = 37 + integer(psb_ipk_), parameter :: mld_n_prec_levs_ = 38 + integer(psb_ipk_), parameter :: mld_max_prec_levs_ = 39 + integer(psb_ipk_), parameter :: mld_min_aggr_ratio_ = 40 + integer(psb_ipk_), parameter :: mld_ifpsz_ = 42 ! ! Legal values for entry: mld_smoother_type_ diff --git a/mlprec/mld_c_inner_mod.f90 b/mlprec/mld_c_inner_mod.f90 index 269bb7ab..929f0b5c 100644 --- a/mlprec/mld_c_inner_mod.f90 +++ b/mlprec/mld_c_inner_mod.f90 @@ -110,12 +110,12 @@ module mld_c_inner_mod interface mld_bld_mlhier_aggsize - subroutine mld_c_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) - use psb_base_mod, only : psb_ipk_, psb_cspmat_type, psb_desc_type + subroutine mld_c_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info) + use psb_base_mod, only : psb_ipk_, psb_cspmat_type, psb_desc_type,psb_spk_ use mld_c_prec_type, only : mld_c_onelev_type implicit none - integer(psb_ipk_), intent(in) :: casize - integer(psb_ipk_), intent(inout) :: iszv + integer(psb_ipk_), intent(in) :: casize,mxplevs + real(psb_spk_) :: mnaggratio type(psb_cspmat_type),intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a type(mld_c_onelev_type), allocatable, target, intent(inout) :: precv(:) @@ -124,12 +124,13 @@ module mld_c_inner_mod end interface mld_bld_mlhier_aggsize interface mld_bld_mlhier_array - subroutine mld_c_bld_mlhier_array(a,desc_a,precv,info) + subroutine mld_c_bld_mlhier_array(nplevs,a,desc_a,precv,info) use psb_base_mod, only : psb_ipk_, psb_cspmat_type, psb_desc_type use mld_c_prec_type, only : mld_c_onelev_type implicit none - type(psb_cspmat_type),intent(in), target :: a - type(psb_desc_type), intent(inout), target :: desc_a + integer(psb_ipk_), intent(inout) :: nplevs + type(psb_cspmat_type),intent(in), target :: a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_c_onelev_type), allocatable, target, intent(inout) :: precv(:) integer(psb_ipk_), intent(out) :: info end subroutine mld_c_bld_mlhier_array diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index 8be65dc2..78f62c9b 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -84,7 +84,8 @@ module mld_c_prec_type integer(psb_ipk_) :: coarse_aggr_size = izero integer(psb_ipk_) :: n_prec_levs = -ione integer(psb_ipk_) :: max_prec_levs = 20_psb_ipk_ - real(psb_spk_) :: op_complexity=szero + real(psb_spk_) :: min_aggr_ratio = 1.5_psb_spk_ + real(psb_spk_) :: op_complexity=szero type(mld_c_onelev_type), allocatable :: precv(:) contains procedure, pass(prec) :: psb_c_apply2_vect => mld_c_apply2_vect diff --git a/mlprec/mld_d_inner_mod.f90 b/mlprec/mld_d_inner_mod.f90 index 668543a2..db1ae267 100644 --- a/mlprec/mld_d_inner_mod.f90 +++ b/mlprec/mld_d_inner_mod.f90 @@ -110,12 +110,12 @@ module mld_d_inner_mod interface mld_bld_mlhier_aggsize - subroutine mld_d_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) - use psb_base_mod, only : psb_ipk_, psb_dspmat_type, psb_desc_type + subroutine mld_d_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info) + use psb_base_mod, only : psb_ipk_, psb_dspmat_type, psb_desc_type,psb_dpk_ use mld_d_prec_type, only : mld_d_onelev_type implicit none - integer(psb_ipk_), intent(in) :: casize - integer(psb_ipk_), intent(inout) :: iszv + integer(psb_ipk_), intent(in) :: casize,mxplevs + real(psb_dpk_) :: mnaggratio type(psb_dspmat_type),intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a type(mld_d_onelev_type), allocatable, target, intent(inout) :: precv(:) @@ -124,12 +124,13 @@ module mld_d_inner_mod end interface mld_bld_mlhier_aggsize interface mld_bld_mlhier_array - subroutine mld_d_bld_mlhier_array(a,desc_a,precv,info) + subroutine mld_d_bld_mlhier_array(nplevs,a,desc_a,precv,info) use psb_base_mod, only : psb_ipk_, psb_dspmat_type, psb_desc_type use mld_d_prec_type, only : mld_d_onelev_type implicit none - type(psb_dspmat_type),intent(in), target :: a - type(psb_desc_type), intent(inout), target :: desc_a + integer(psb_ipk_), intent(inout) :: nplevs + type(psb_dspmat_type),intent(in), target :: a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_d_onelev_type), allocatable, target, intent(inout) :: precv(:) integer(psb_ipk_), intent(out) :: info end subroutine mld_d_bld_mlhier_array diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index 8e1fb6c0..7ddfeeb9 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -84,7 +84,8 @@ module mld_d_prec_type integer(psb_ipk_) :: coarse_aggr_size = izero integer(psb_ipk_) :: n_prec_levs = -ione integer(psb_ipk_) :: max_prec_levs = 20_psb_ipk_ - real(psb_dpk_) :: op_complexity=dzero + real(psb_dpk_) :: min_aggr_ratio = 1.5_psb_dpk_ + real(psb_dpk_) :: op_complexity=dzero type(mld_d_onelev_type), allocatable :: precv(:) contains procedure, pass(prec) :: psb_d_apply2_vect => mld_d_apply2_vect diff --git a/mlprec/mld_s_inner_mod.f90 b/mlprec/mld_s_inner_mod.f90 index 017496e4..4dc9922e 100644 --- a/mlprec/mld_s_inner_mod.f90 +++ b/mlprec/mld_s_inner_mod.f90 @@ -110,12 +110,12 @@ module mld_s_inner_mod interface mld_bld_mlhier_aggsize - subroutine mld_s_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) - use psb_base_mod, only : psb_ipk_, psb_sspmat_type, psb_desc_type + subroutine mld_s_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info) + use psb_base_mod, only : psb_ipk_, psb_sspmat_type, psb_desc_type,psb_spk_ use mld_s_prec_type, only : mld_s_onelev_type implicit none - integer(psb_ipk_), intent(in) :: casize - integer(psb_ipk_), intent(inout) :: iszv + integer(psb_ipk_), intent(in) :: casize,mxplevs + real(psb_spk_) :: mnaggratio type(psb_sspmat_type),intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a type(mld_s_onelev_type), allocatable, target, intent(inout) :: precv(:) @@ -124,12 +124,13 @@ module mld_s_inner_mod end interface mld_bld_mlhier_aggsize interface mld_bld_mlhier_array - subroutine mld_s_bld_mlhier_array(a,desc_a,precv,info) + subroutine mld_s_bld_mlhier_array(nplevs,a,desc_a,precv,info) use psb_base_mod, only : psb_ipk_, psb_sspmat_type, psb_desc_type use mld_s_prec_type, only : mld_s_onelev_type implicit none - type(psb_sspmat_type),intent(in), target :: a - type(psb_desc_type), intent(inout), target :: desc_a + integer(psb_ipk_), intent(inout) :: nplevs + type(psb_sspmat_type),intent(in), target :: a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_s_onelev_type), allocatable, target, intent(inout) :: precv(:) integer(psb_ipk_), intent(out) :: info end subroutine mld_s_bld_mlhier_array diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index d7209e73..dd1556d7 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -84,7 +84,8 @@ module mld_s_prec_type integer(psb_ipk_) :: coarse_aggr_size = izero integer(psb_ipk_) :: n_prec_levs = -ione integer(psb_ipk_) :: max_prec_levs = 20_psb_ipk_ - real(psb_spk_) :: op_complexity=szero + real(psb_spk_) :: min_aggr_ratio = 1.5_psb_spk_ + real(psb_spk_) :: op_complexity=szero type(mld_s_onelev_type), allocatable :: precv(:) contains procedure, pass(prec) :: psb_s_apply2_vect => mld_s_apply2_vect diff --git a/mlprec/mld_z_inner_mod.f90 b/mlprec/mld_z_inner_mod.f90 index a90ea2a6..6ed824f1 100644 --- a/mlprec/mld_z_inner_mod.f90 +++ b/mlprec/mld_z_inner_mod.f90 @@ -110,12 +110,12 @@ module mld_z_inner_mod interface mld_bld_mlhier_aggsize - subroutine mld_z_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info) - use psb_base_mod, only : psb_ipk_, psb_zspmat_type, psb_desc_type + subroutine mld_z_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info) + use psb_base_mod, only : psb_ipk_, psb_zspmat_type, psb_desc_type,psb_dpk_ use mld_z_prec_type, only : mld_z_onelev_type implicit none - integer(psb_ipk_), intent(in) :: casize - integer(psb_ipk_), intent(inout) :: iszv + integer(psb_ipk_), intent(in) :: casize,mxplevs + real(psb_dpk_) :: mnaggratio type(psb_zspmat_type),intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a type(mld_z_onelev_type), allocatable, target, intent(inout) :: precv(:) @@ -124,12 +124,13 @@ module mld_z_inner_mod end interface mld_bld_mlhier_aggsize interface mld_bld_mlhier_array - subroutine mld_z_bld_mlhier_array(a,desc_a,precv,info) + subroutine mld_z_bld_mlhier_array(nplevs,a,desc_a,precv,info) use psb_base_mod, only : psb_ipk_, psb_zspmat_type, psb_desc_type use mld_z_prec_type, only : mld_z_onelev_type implicit none - type(psb_zspmat_type),intent(in), target :: a - type(psb_desc_type), intent(inout), target :: desc_a + integer(psb_ipk_), intent(inout) :: nplevs + type(psb_zspmat_type),intent(in), target :: a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_z_onelev_type), allocatable, target, intent(inout) :: precv(:) integer(psb_ipk_), intent(out) :: info end subroutine mld_z_bld_mlhier_array diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index b85a5ba7..7597e2c8 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -84,7 +84,8 @@ module mld_z_prec_type integer(psb_ipk_) :: coarse_aggr_size = izero integer(psb_ipk_) :: n_prec_levs = -ione integer(psb_ipk_) :: max_prec_levs = 20_psb_ipk_ - real(psb_dpk_) :: op_complexity=dzero + real(psb_dpk_) :: min_aggr_ratio = 1.5_psb_dpk_ + real(psb_dpk_) :: op_complexity=dzero type(mld_z_onelev_type), allocatable :: precv(:) contains procedure, pass(prec) :: psb_z_apply2_vect => mld_z_apply2_vect diff --git a/tests/pdegen/ppde3d.f90 b/tests/pdegen/ppde3d.f90 index 47a28a2e..0a302701 100644 --- a/tests/pdegen/ppde3d.f90 +++ b/tests/pdegen/ppde3d.f90 @@ -242,7 +242,8 @@ program ppde3d ! if (psb_toupper(prectype%prec) == 'ML') then nlv = prectype%nlev - call mld_precinit(prec,prectype%prec, info, nlev=nlv) + call mld_precinit(prec,prectype%prec, info, nlev=nlv) +!!$ call mld_precset(prec,'n_prec_levs', prectype%nlev, info) call mld_precset(prec,'smoother_type', prectype%smther, info) call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info) call mld_precset(prec,'sub_ovr', prectype%novr, info) @@ -265,7 +266,7 @@ program ppde3d call mld_precset(prec,'coarse_fillin', prectype%cfill, info) call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info) call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info) - call mld_precset(prec,'coarse_aggr_size', prectype%csize, info) + if (prectype%csize>0) call mld_precset(prec,'coarse_aggr_size', prectype%csize, info) else nlv = 1 call mld_precinit(prec,prectype%prec, info, nlev=nlv)