diff --git a/mlprec/impl/mld_c_bld_mlhier_aggsize.f90 b/mlprec/impl/mld_c_bld_mlhier_aggsize.f90 index 8b176380..cf3ec60e 100644 --- a/mlprec/impl/mld_c_bld_mlhier_aggsize.f90 +++ b/mlprec/impl/mld_c_bld_mlhier_aggsize.f90 @@ -124,7 +124,8 @@ subroutine mld_c_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf newnode%prev => current newsz = newsz + 1 newnode%item%parms = medparms - newnode%item%parms%aggr_thresh = current%item%parms%aggr_thresh/2 + newnode%item%parms%aggr_thresh = & + & (current%item%parms%aggr_thresh)*(current%item%parms%aggr_scale) call mld_coarse_bld(current%item%base_a, current%item%base_desc, & & newnode%item,info) if (info /= psb_success_) then @@ -166,21 +167,27 @@ subroutine mld_c_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf end do list_build_loop ! - ! At this point, we are at the list tail, - ! and it needs to be rebuilt in case the parms were - ! different. - ! - ! But the threshold has to be fixed before rebuliding + ! At this point, we are at the list tail. + ! If the top aggregation parameters were different, then we need to rebuild; + ! the threshold has to be fixed before rebuliding, and the parms must be + ! copied anyway since they'll be used later for the smoother build. + ! coarseparms%aggr_thresh = current%item%parms%aggr_thresh - current%item%parms = coarseparms - call mld_coarse_bld(current%prev%item%base_a,& - & current%prev%item%base_desc, & - & current%item,info) - if (info /= psb_success_) then - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='build next level'); goto 9999 + + if (.not.mld_equal_aggregation(current%item%parms, coarseparms)) then + ! Need to rebuild. + current%item%parms = coarseparms + call mld_coarse_bld(current%prev%item%base_a,& + & current%prev%item%base_desc, & + & current%item,info) + if (info /= psb_success_) then + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='build next level'); goto 9999 + end if + else + ! Need only copy the parms. + current%item%parms = coarseparms end if - ! ! Ok, now allocate the output vector and fix items. ! diff --git a/mlprec/impl/mld_cprecinit.F90 b/mlprec/impl/mld_cprecinit.F90 index 8027c9e5..3681caac 100644 --- a/mlprec/impl/mld_cprecinit.F90 +++ b/mlprec/impl/mld_cprecinit.F90 @@ -202,8 +202,8 @@ subroutine mld_cprecinit(p,ptype,info,nlev) call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_ovr_,izero,info) - thr = 0.05 - scale = 1.0 + thr = 0.05_psb_spk_ + scale = 1.0_psb_spk_ do ilev_=1,nlev_ call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call p%precv(ilev_)%set(mld_aggr_scale_,scale,info) diff --git a/mlprec/impl/mld_d_bld_mlhier_aggsize.f90 b/mlprec/impl/mld_d_bld_mlhier_aggsize.f90 index 82ddb2a6..838ef25c 100644 --- a/mlprec/impl/mld_d_bld_mlhier_aggsize.f90 +++ b/mlprec/impl/mld_d_bld_mlhier_aggsize.f90 @@ -124,7 +124,8 @@ subroutine mld_d_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf newnode%prev => current newsz = newsz + 1 newnode%item%parms = medparms - newnode%item%parms%aggr_thresh = current%item%parms%aggr_thresh/2 + newnode%item%parms%aggr_thresh = & + & (current%item%parms%aggr_thresh)*(current%item%parms%aggr_scale) call mld_coarse_bld(current%item%base_a, current%item%base_desc, & & newnode%item,info) if (info /= psb_success_) then @@ -166,21 +167,27 @@ subroutine mld_d_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf end do list_build_loop ! - ! At this point, we are at the list tail, - ! and it needs to be rebuilt in case the parms were - ! different. - ! - ! But the threshold has to be fixed before rebuliding + ! At this point, we are at the list tail. + ! If the top aggregation parameters were different, then we need to rebuild; + ! the threshold has to be fixed before rebuliding, and the parms must be + ! copied anyway since they'll be used later for the smoother build. + ! coarseparms%aggr_thresh = current%item%parms%aggr_thresh - current%item%parms = coarseparms - call mld_coarse_bld(current%prev%item%base_a,& - & current%prev%item%base_desc, & - & current%item,info) - if (info /= psb_success_) then - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='build next level'); goto 9999 + + if (.not.mld_equal_aggregation(current%item%parms, coarseparms)) then + ! Need to rebuild. + current%item%parms = coarseparms + call mld_coarse_bld(current%prev%item%base_a,& + & current%prev%item%base_desc, & + & current%item,info) + if (info /= psb_success_) then + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='build next level'); goto 9999 + end if + else + ! Need only copy the parms. + current%item%parms = coarseparms end if - ! ! Ok, now allocate the output vector and fix items. ! diff --git a/mlprec/impl/mld_dprecinit.F90 b/mlprec/impl/mld_dprecinit.F90 index 7590f6ce..3276c9e7 100644 --- a/mlprec/impl/mld_dprecinit.F90 +++ b/mlprec/impl/mld_dprecinit.F90 @@ -207,8 +207,8 @@ subroutine mld_dprecinit(p,ptype,info,nlev) call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_ovr_,izero,info) - thr = 0.05 - scale = 1.0 + thr = 0.05_psb_dpk_ + scale = 1.0_psb_dpk_ do ilev_=1,nlev_ call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call p%precv(ilev_)%set(mld_aggr_scale_,scale,info) diff --git a/mlprec/impl/mld_s_bld_mlhier_aggsize.f90 b/mlprec/impl/mld_s_bld_mlhier_aggsize.f90 index 5c4bc92f..9be3473c 100644 --- a/mlprec/impl/mld_s_bld_mlhier_aggsize.f90 +++ b/mlprec/impl/mld_s_bld_mlhier_aggsize.f90 @@ -124,7 +124,8 @@ subroutine mld_s_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf newnode%prev => current newsz = newsz + 1 newnode%item%parms = medparms - newnode%item%parms%aggr_thresh = current%item%parms%aggr_thresh/2 + newnode%item%parms%aggr_thresh = & + & (current%item%parms%aggr_thresh)*(current%item%parms%aggr_scale) call mld_coarse_bld(current%item%base_a, current%item%base_desc, & & newnode%item,info) if (info /= psb_success_) then @@ -166,21 +167,27 @@ subroutine mld_s_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf end do list_build_loop ! - ! At this point, we are at the list tail, - ! and it needs to be rebuilt in case the parms were - ! different. - ! - ! But the threshold has to be fixed before rebuliding + ! At this point, we are at the list tail. + ! If the top aggregation parameters were different, then we need to rebuild; + ! the threshold has to be fixed before rebuliding, and the parms must be + ! copied anyway since they'll be used later for the smoother build. + ! coarseparms%aggr_thresh = current%item%parms%aggr_thresh - current%item%parms = coarseparms - call mld_coarse_bld(current%prev%item%base_a,& - & current%prev%item%base_desc, & - & current%item,info) - if (info /= psb_success_) then - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='build next level'); goto 9999 + + if (.not.mld_equal_aggregation(current%item%parms, coarseparms)) then + ! Need to rebuild. + current%item%parms = coarseparms + call mld_coarse_bld(current%prev%item%base_a,& + & current%prev%item%base_desc, & + & current%item,info) + if (info /= psb_success_) then + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='build next level'); goto 9999 + end if + else + ! Need only copy the parms. + current%item%parms = coarseparms end if - ! ! Ok, now allocate the output vector and fix items. ! diff --git a/mlprec/impl/mld_sprecinit.F90 b/mlprec/impl/mld_sprecinit.F90 index 16ee4351..5474d9b5 100644 --- a/mlprec/impl/mld_sprecinit.F90 +++ b/mlprec/impl/mld_sprecinit.F90 @@ -202,8 +202,8 @@ subroutine mld_sprecinit(p,ptype,info,nlev) call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_ovr_,izero,info) - thr = 0.05 - scale = 1.0 + thr = 0.05_psb_spk_ + scale = 1.0_psb_spk_ do ilev_=1,nlev_ call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call p%precv(ilev_)%set(mld_aggr_scale_,scale,info) diff --git a/mlprec/impl/mld_z_bld_mlhier_aggsize.f90 b/mlprec/impl/mld_z_bld_mlhier_aggsize.f90 index fdfb08ea..9ae5da74 100644 --- a/mlprec/impl/mld_z_bld_mlhier_aggsize.f90 +++ b/mlprec/impl/mld_z_bld_mlhier_aggsize.f90 @@ -124,7 +124,8 @@ subroutine mld_z_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf newnode%prev => current newsz = newsz + 1 newnode%item%parms = medparms - newnode%item%parms%aggr_thresh = current%item%parms%aggr_thresh/2 + newnode%item%parms%aggr_thresh = & + & (current%item%parms%aggr_thresh)*(current%item%parms%aggr_scale) call mld_coarse_bld(current%item%base_a, current%item%base_desc, & & newnode%item,info) if (info /= psb_success_) then @@ -166,21 +167,27 @@ subroutine mld_z_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf end do list_build_loop ! - ! At this point, we are at the list tail, - ! and it needs to be rebuilt in case the parms were - ! different. - ! - ! But the threshold has to be fixed before rebuliding + ! At this point, we are at the list tail. + ! If the top aggregation parameters were different, then we need to rebuild; + ! the threshold has to be fixed before rebuliding, and the parms must be + ! copied anyway since they'll be used later for the smoother build. + ! coarseparms%aggr_thresh = current%item%parms%aggr_thresh - current%item%parms = coarseparms - call mld_coarse_bld(current%prev%item%base_a,& - & current%prev%item%base_desc, & - & current%item,info) - if (info /= psb_success_) then - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='build next level'); goto 9999 + + if (.not.mld_equal_aggregation(current%item%parms, coarseparms)) then + ! Need to rebuild. + current%item%parms = coarseparms + call mld_coarse_bld(current%prev%item%base_a,& + & current%prev%item%base_desc, & + & current%item,info) + if (info /= psb_success_) then + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='build next level'); goto 9999 + end if + else + ! Need only copy the parms. + current%item%parms = coarseparms end if - ! ! Ok, now allocate the output vector and fix items. ! diff --git a/mlprec/impl/mld_zprecinit.F90 b/mlprec/impl/mld_zprecinit.F90 index b10c38fc..548f7d85 100644 --- a/mlprec/impl/mld_zprecinit.F90 +++ b/mlprec/impl/mld_zprecinit.F90 @@ -207,8 +207,8 @@ subroutine mld_zprecinit(p,ptype,info,nlev) call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call p%precv(ilev_)%set(mld_sub_ovr_,izero,info) - thr = 0.05 - scale = 1.0 + thr = 0.05_psb_dpk_ + scale = 1.0_psb_dpk_ do ilev_=1,nlev_ call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call p%precv(ilev_)%set(mld_aggr_scale_,scale,info) diff --git a/tests/fileread/mld_cf_sample.f90 b/tests/fileread/mld_cf_sample.f90 index d0c9ed6f..7827e195 100644 --- a/tests/fileread/mld_cf_sample.f90 +++ b/tests/fileread/mld_cf_sample.f90 @@ -260,6 +260,8 @@ program mld_cf_sample call mld_precset(prec,'aggr_kind', prec_choice%aggrkind,info) call mld_precset(prec,'aggr_alg', prec_choice%aggr_alg,info) call mld_precset(prec,'aggr_ord', prec_choice%aggr_ord,info) + call mld_precset(prec,'aggr_scale', prec_choice%ascale, info) + call mld_precset(prec,'aggr_thresh', prec_choice%athres, info) call psb_barrier(ictxt) t1 = psb_wtime() call mld_hierarchy_bld(a,desc_a,prec,info) @@ -279,8 +281,6 @@ program mld_cf_sample call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info) call mld_precset(prec,'ml_type', prec_choice%mltype, info) call mld_precset(prec,'smoother_pos', prec_choice%smthpos, info) - call mld_precset(prec,'aggr_scale', prec_choice%ascale, info) - call mld_precset(prec,'aggr_thresh', prec_choice%athres, info) call mld_precset(prec,'coarse_solve', prec_choice%csolve, info) call mld_precset(prec,'coarse_subsolve', prec_choice%csbsolve,info) call mld_precset(prec,'coarse_mat', prec_choice%cmat, info) diff --git a/tests/fileread/mld_df_sample.f90 b/tests/fileread/mld_df_sample.f90 index 833f8e06..c8e16511 100644 --- a/tests/fileread/mld_df_sample.f90 +++ b/tests/fileread/mld_df_sample.f90 @@ -260,6 +260,8 @@ program mld_df_sample call mld_precset(prec,'aggr_kind', prec_choice%aggrkind,info) call mld_precset(prec,'aggr_alg', prec_choice%aggr_alg,info) call mld_precset(prec,'aggr_ord', prec_choice%aggr_ord,info) + call mld_precset(prec,'aggr_scale', prec_choice%ascale, info) + call mld_precset(prec,'aggr_thresh', prec_choice%athres, info) call psb_barrier(ictxt) t1 = psb_wtime() call mld_hierarchy_bld(a,desc_a,prec,info) @@ -279,8 +281,6 @@ program mld_df_sample call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info) call mld_precset(prec,'ml_type', prec_choice%mltype, info) call mld_precset(prec,'smoother_pos', prec_choice%smthpos, info) - call mld_precset(prec,'aggr_scale', prec_choice%ascale, info) - call mld_precset(prec,'aggr_thresh', prec_choice%athres, info) call mld_precset(prec,'coarse_solve', prec_choice%csolve, info) call mld_precset(prec,'coarse_subsolve', prec_choice%csbsolve,info) call mld_precset(prec,'coarse_mat', prec_choice%cmat, info) diff --git a/tests/fileread/mld_sf_sample.f90 b/tests/fileread/mld_sf_sample.f90 index 7dcc0350..2d0a23fd 100644 --- a/tests/fileread/mld_sf_sample.f90 +++ b/tests/fileread/mld_sf_sample.f90 @@ -260,6 +260,8 @@ program mld_sf_sample call mld_precset(prec,'aggr_kind', prec_choice%aggrkind,info) call mld_precset(prec,'aggr_alg', prec_choice%aggr_alg,info) call mld_precset(prec,'aggr_ord', prec_choice%aggr_ord,info) + call mld_precset(prec,'aggr_scale', prec_choice%ascale, info) + call mld_precset(prec,'aggr_thresh', prec_choice%athres, info) call psb_barrier(ictxt) t1 = psb_wtime() call mld_hierarchy_bld(a,desc_a,prec,info) @@ -279,8 +281,6 @@ program mld_sf_sample call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info) call mld_precset(prec,'ml_type', prec_choice%mltype, info) call mld_precset(prec,'smoother_pos', prec_choice%smthpos, info) - call mld_precset(prec,'aggr_scale', prec_choice%ascale, info) - call mld_precset(prec,'aggr_thresh', prec_choice%athres, info) call mld_precset(prec,'coarse_solve', prec_choice%csolve, info) call mld_precset(prec,'coarse_subsolve', prec_choice%csbsolve,info) call mld_precset(prec,'coarse_mat', prec_choice%cmat, info) diff --git a/tests/fileread/mld_zf_sample.f90 b/tests/fileread/mld_zf_sample.f90 index 731d2b71..84980d6f 100644 --- a/tests/fileread/mld_zf_sample.f90 +++ b/tests/fileread/mld_zf_sample.f90 @@ -260,6 +260,8 @@ program mld_zf_sample call mld_precset(prec,'aggr_kind', prec_choice%aggrkind,info) call mld_precset(prec,'aggr_alg', prec_choice%aggr_alg,info) call mld_precset(prec,'aggr_ord', prec_choice%aggr_ord,info) + call mld_precset(prec,'aggr_scale', prec_choice%ascale, info) + call mld_precset(prec,'aggr_thresh', prec_choice%athres, info) call psb_barrier(ictxt) t1 = psb_wtime() call mld_hierarchy_bld(a,desc_a,prec,info) @@ -279,8 +281,6 @@ program mld_zf_sample call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info) call mld_precset(prec,'ml_type', prec_choice%mltype, info) call mld_precset(prec,'smoother_pos', prec_choice%smthpos, info) - call mld_precset(prec,'aggr_scale', prec_choice%ascale, info) - call mld_precset(prec,'aggr_thresh', prec_choice%athres, info) call mld_precset(prec,'coarse_solve', prec_choice%csolve, info) call mld_precset(prec,'coarse_subsolve', prec_choice%csbsolve,info) call mld_precset(prec,'coarse_mat', prec_choice%cmat, info)