mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 22:55:12 +00:00
mld2p4-2
mlprec/impl/mld_c_bld_mlhier_aggsize.f90 mlprec/impl/mld_cprecinit.F90 mlprec/impl/mld_d_bld_mlhier_aggsize.f90 mlprec/impl/mld_dprecinit.F90 mlprec/impl/mld_s_bld_mlhier_aggsize.f90 mlprec/impl/mld_sprecinit.F90 mlprec/impl/mld_z_bld_mlhier_aggsize.f90 mlprec/impl/mld_zprecinit.F90 tests/fileread/mld_cf_sample.f90 tests/fileread/mld_df_sample.f90 tests/fileread/mld_sf_sample.f90 tests/fileread/mld_zf_sample.f90 Use kind in initialization of threshold/scale. Fix use of SCALE in mlhier_aggsize Fix precset for thresh and scale in mld_Xf_sample.
This commit is contained in:
Salvatore Filippone
@@ -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.
|
||||
!
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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.
|
||||
!
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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.
|
||||
!
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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.
|
||||
!
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user