From 466e0b442a54a82314732e11b8f4854db2132fbe Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 1 Oct 2016 18:15:21 +0000 Subject: [PATCH] mld2p4-extaggr: mlprec/impl/mld_cprecinit.F90 mlprec/impl/mld_dprecinit.F90 mlprec/impl/mld_sprecinit.F90 mlprec/impl/mld_zprecinit.F90 mlprec/mld_base_prec_type.F90 tests/pdegen/mld_d_pde2d.f90 tests/pdegen/mld_d_pde3d.f90 tests/pdegen/mld_s_pde2d.f90 tests/pdegen/mld_s_pde3d.f90 tests/pdegen/runs/ppde.inp Initialize aggr_filter. Update test programs to control dump and filtering from input file. --- mlprec/impl/mld_cprecinit.F90 | 1 + mlprec/impl/mld_dprecinit.F90 | 1 + mlprec/impl/mld_sprecinit.F90 | 1 + mlprec/impl/mld_zprecinit.F90 | 1 + mlprec/mld_base_prec_type.F90 | 3 ++ tests/pdegen/mld_d_pde2d.f90 | 47 +++++++++++++++++-------- tests/pdegen/mld_d_pde3d.f90 | 39 +++++++++++---------- tests/pdegen/mld_s_pde2d.f90 | 61 +++++++++++++++++++++----------- tests/pdegen/mld_s_pde3d.f90 | 65 ++++++++++++++++++++++------------- tests/pdegen/runs/ppde.inp | 9 ++--- 10 files changed, 148 insertions(+), 80 deletions(-) diff --git a/mlprec/impl/mld_cprecinit.F90 b/mlprec/impl/mld_cprecinit.F90 index 3681caac..7435f11f 100644 --- a/mlprec/impl/mld_cprecinit.F90 +++ b/mlprec/impl/mld_cprecinit.F90 @@ -207,6 +207,7 @@ subroutine mld_cprecinit(p,ptype,info,nlev) do ilev_=1,nlev_ call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call p%precv(ilev_)%set(mld_aggr_scale_,scale,info) + call p%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info) end do case default diff --git a/mlprec/impl/mld_dprecinit.F90 b/mlprec/impl/mld_dprecinit.F90 index 3276c9e7..cdb3f7b2 100644 --- a/mlprec/impl/mld_dprecinit.F90 +++ b/mlprec/impl/mld_dprecinit.F90 @@ -212,6 +212,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev) do ilev_=1,nlev_ call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call p%precv(ilev_)%set(mld_aggr_scale_,scale,info) + call p%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info) end do case default diff --git a/mlprec/impl/mld_sprecinit.F90 b/mlprec/impl/mld_sprecinit.F90 index 5474d9b5..692b55ca 100644 --- a/mlprec/impl/mld_sprecinit.F90 +++ b/mlprec/impl/mld_sprecinit.F90 @@ -207,6 +207,7 @@ subroutine mld_sprecinit(p,ptype,info,nlev) do ilev_=1,nlev_ call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call p%precv(ilev_)%set(mld_aggr_scale_,scale,info) + call p%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info) end do case default diff --git a/mlprec/impl/mld_zprecinit.F90 b/mlprec/impl/mld_zprecinit.F90 index 548f7d85..f6f9a4b7 100644 --- a/mlprec/impl/mld_zprecinit.F90 +++ b/mlprec/impl/mld_zprecinit.F90 @@ -212,6 +212,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev) do ilev_=1,nlev_ call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call p%precv(ilev_)%set(mld_aggr_scale_,scale,info) + call p%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info) end do case default diff --git a/mlprec/mld_base_prec_type.F90 b/mlprec/mld_base_prec_type.F90 index 2fbdec20..1389568b 100644 --- a/mlprec/mld_base_prec_type.F90 +++ b/mlprec/mld_base_prec_type.F90 @@ -334,6 +334,8 @@ module mld_base_prec_type character(len=15), parameter, private :: & & aggr_kinds(0:3)=(/'unsmoothed ','smoothed ',& & 'min energy ','bizr. smoothed'/) + character(len=15), parameter, private :: & + & aggr_filters(0:1)=(/'no filtering ','filtering '/) character(len=15), parameter, private :: & & matrix_names(0:1)=(/'distributed ','replicated '/) character(len=18), parameter, private :: & @@ -603,6 +605,7 @@ contains write(iout,*) ' Aggregation type: ', & & aggr_kinds(pm%aggr_kind) if (pm%aggr_kind /= mld_no_smooth_) then + write(iout,*) ' with: ', aggr_filters(pm%aggr_filter) if (pm%aggr_omega_alg == mld_eig_est_) then write(iout,*) ' Damping omega computation: spectral radius estimate' write(iout,*) ' Spectral radius estimate: ', & diff --git a/tests/pdegen/mld_d_pde2d.f90 b/tests/pdegen/mld_d_pde2d.f90 index a8720a61..a085aa3e 100644 --- a/tests/pdegen/mld_d_pde2d.f90 +++ b/tests/pdegen/mld_d_pde2d.f90 @@ -1,8 +1,8 @@ !!!$ !!$ -!!$ MLD2P4 version 2.0 +!!$ MLD2P4 version 2.1 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package -!!$ based on PSBLAS (Parallel Sparse BLAS version 3.3) +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.4) !!$ !!$ (C) Copyright 2008, 2010, 2012, 2015 !!$ @@ -69,34 +69,34 @@ contains ! functions parametrizing the differential equation ! function b1(x,y) - use psb_base_mod, only : psb_dpk_ + use psb_base_mod, only : psb_dpk_,done,dzero real(psb_dpk_) :: b1 real(psb_dpk_), intent(in) :: x,y - b1=0.d0/sqrt(2.d0) + b1=dzero/sqrt((2*done)) end function b1 function b2(x,y) - use psb_base_mod, only : psb_dpk_ + use psb_base_mod, only : psb_dpk_,done,dzero real(psb_dpk_) :: b2 real(psb_dpk_), intent(in) :: x,y - b2=0.d0/sqrt(2.d0) + b2=dzero/sqrt((2*done)) end function b2 function c(x,y) - use psb_base_mod, only : psb_dpk_ + use psb_base_mod, only : psb_dpk_,done,dzero real(psb_dpk_) :: c real(psb_dpk_), intent(in) :: x,y - c=0.d0 + c=dzero end function c function a1(x,y) - use psb_base_mod, only : psb_dpk_ + use psb_base_mod, only : psb_dpk_,done,dzero real(psb_dpk_) :: a1 real(psb_dpk_), intent(in) :: x,y - a1=1.d0!/80 + a1=done!/80 end function a1 function a2(x,y) - use psb_base_mod, only : psb_dpk_ + use psb_base_mod, only : psb_dpk_,done,dzero real(psb_dpk_) :: a2 real(psb_dpk_), intent(in) :: x,y - a2=1.d0!/80 + a2=done!/80 end function a2 function g(x,y) use psb_base_mod, only : psb_dpk_, done, dzero @@ -160,6 +160,7 @@ program mld_d_pde2d character(len=16) :: aggrkind ! smoothed/raw aggregatin character(len=16) :: aggr_alg ! local or global aggregation character(len=16) :: aggr_ord ! Ordering for aggregation + character(len=16) :: aggr_filter ! Use filtering? character(len=16) :: mltype ! additive or multiplicative 2nd level prec character(len=16) :: smthpos ! side: pre, post, both smoothing integer(psb_ipk_) :: csize ! aggregation size at which to stop. @@ -175,6 +176,8 @@ program mld_d_pde2d type(precdata) :: prectype type(psb_d_coo_sparse_mat) :: acoo ! other variables + logical :: dump_prec + character(len=40) :: dump_prefix integer(psb_ipk_) :: info, i character(len=20) :: name,ch_err @@ -203,7 +206,8 @@ program mld_d_pde2d ! ! get parameters ! - call get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst,eps) + call get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst,eps,& + & dump_prec,dump_prefix) ! ! allocate and fill in the coefficient matrix, rhs and initial guess @@ -246,6 +250,7 @@ program mld_d_pde2d call mld_precset(prec,'aggr_kind', prectype%aggrkind,info) call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info) call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info) + call mld_precset(prec,'aggr_filter', prectype%aggr_filter, info) call psb_barrier(ictxt) t1 = psb_wtime() @@ -368,6 +373,10 @@ program mld_d_pde2d write(psb_out_unit,'("Total memory occupation for PREC: ",i12)') precsize end if + if (dump_prec) call prec%dump(info,prefix=trim(dump_prefix),& + & ac=.true.,solver=.true.,smoother=.true.,rp=.true.,global_num=.true.) + + ! ! cleanup storage and exit ! @@ -392,13 +401,17 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst,eps) + subroutine get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst,eps,& + & dump_prec,dump_prefix) + integer(psb_ipk_) :: ictxt type(precdata) :: prectype character(len=*) :: kmethd, afmt integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst integer(psb_ipk_) :: np, iam, info real(psb_dpk_) :: eps + logical :: dump_prec + character(len=*) :: dump_prefix character(len=20) :: buffer call psb_info(ictxt, iam, np) @@ -412,6 +425,8 @@ contains call read_data(itrace,psb_inp_unit) call read_data(irst,psb_inp_unit) call read_data(eps,psb_inp_unit) + call read_data(dump_prec,psb_inp_unit) + call read_data(dump_prefix,psb_inp_unit) call read_data(prectype%descr,psb_inp_unit) ! verbose description of the prec call read_data(prectype%prec,psb_inp_unit) ! overall prectype call read_data(prectype%nlevs,psb_inp_unit) ! Prescribed number of levels @@ -422,6 +437,7 @@ contains call read_data(prectype%aggrkind,psb_inp_unit) ! smoothed/nonsmoothed/minenergy aggregatin call read_data(prectype%aggr_alg,psb_inp_unit) ! decoupled or sym. decoupled aggregation call read_data(prectype%aggr_ord,psb_inp_unit) ! aggregation ordering: natural, node degree + call read_data(prectype%aggr_filter,psb_inp_unit) ! aggregation filtering: filter, no_filter call read_data(prectype%mltype,psb_inp_unit) ! additive or multiplicative 2nd level prec call read_data(prectype%smthpos,psb_inp_unit) ! side: pre, post, both smoothing call read_data(prectype%jsweeps,psb_inp_unit) ! Smoother sweeps @@ -450,6 +466,8 @@ contains call psb_bcast(ictxt,itrace) call psb_bcast(ictxt,irst) call psb_bcast(ictxt,eps) + call psb_bcast(ictxt,dump_prec) + call psb_bcast(ictxt,dump_prefix) call psb_bcast(ictxt,prectype%descr) ! verbose description of the prec call psb_bcast(ictxt,prectype%prec) ! overall prectype call psb_bcast(ictxt,prectype%nlevs) ! Prescribed number of levels @@ -460,6 +478,7 @@ contains call psb_bcast(ictxt,prectype%aggrkind) ! smoothed/nonsmoothed/minenergy aggregatin call psb_bcast(ictxt,prectype%aggr_alg) ! decoupled or sym. decoupled aggregation call psb_bcast(ictxt,prectype%aggr_ord) ! aggregation ordering: natural, node degree + call psb_bcast(ictxt,prectype%aggr_filter) ! aggregation filtering: filter, no_filter call psb_bcast(ictxt,prectype%mltype) ! additive or multiplicative 2nd level prec call psb_bcast(ictxt,prectype%smthpos) ! side: pre, post, both smoothing call psb_bcast(ictxt,prectype%jsweeps) ! Smoother sweeps diff --git a/tests/pdegen/mld_d_pde3d.f90 b/tests/pdegen/mld_d_pde3d.f90 index 6a29ed84..1dae12e1 100644 --- a/tests/pdegen/mld_d_pde3d.f90 +++ b/tests/pdegen/mld_d_pde3d.f90 @@ -68,49 +68,49 @@ contains ! functions parametrizing the differential equation ! function b1(x,y,z) - use psb_base_mod, only : psb_dpk_ + use psb_base_mod, only : psb_dpk_,done,dzero real(psb_dpk_) :: b1 real(psb_dpk_), intent(in) :: x,y,z - b1=0.d0/sqrt(3.d0) + b1=dzero/sqrt((3*done)) end function b1 function b2(x,y,z) - use psb_base_mod, only : psb_dpk_ + use psb_base_mod, only : psb_dpk_,done,dzero real(psb_dpk_) :: b2 real(psb_dpk_), intent(in) :: x,y,z - b2=0.d0/sqrt(3.d0) + b2=dzero/sqrt((3*done)) end function b2 function b3(x,y,z) - use psb_base_mod, only : psb_dpk_ + use psb_base_mod, only : psb_dpk_,done,dzero real(psb_dpk_) :: b3 real(psb_dpk_), intent(in) :: x,y,z - b3=0.d0/sqrt(3.d0) + b3=dzero/sqrt((3*done)) end function b3 function c(x,y,z) - use psb_base_mod, only : psb_dpk_ + use psb_base_mod, only : psb_dpk_,done,dzero real(psb_dpk_) :: c real(psb_dpk_), intent(in) :: x,y,z - c=0.d0 + c=dzero end function c function a1(x,y,z) - use psb_base_mod, only : psb_dpk_ + use psb_base_mod, only : psb_dpk_,done,dzero real(psb_dpk_) :: a1 real(psb_dpk_), intent(in) :: x,y,z - a1=1.d0!/80 + a1=done!/80 end function a1 function a2(x,y,z) - use psb_base_mod, only : psb_dpk_ + use psb_base_mod, only : psb_dpk_,done,dzero real(psb_dpk_) :: a2 real(psb_dpk_), intent(in) :: x,y,z - a2=1.d0!/80 + a2=done!/80 end function a2 function a3(x,y,z) - use psb_base_mod, only : psb_dpk_ + use psb_base_mod, only : psb_dpk_,done,dzero real(psb_dpk_) :: a3 real(psb_dpk_), intent(in) :: x,y,z - a3=1.d0!/80 + a3=done!/80 end function a3 function g(x,y,z) - use psb_base_mod, only : psb_dpk_, done, dzero + use psb_base_mod, only : psb_dpk_,done,dzero real(psb_dpk_) :: g real(psb_dpk_), intent(in) :: x,y,z g = dzero @@ -171,6 +171,7 @@ program mld_d_pde3d character(len=16) :: aggrkind ! smoothed/raw aggregatin character(len=16) :: aggr_alg ! local or global aggregation character(len=16) :: aggr_ord ! Ordering for aggregation + character(len=16) :: aggr_filter ! Use filtering? character(len=16) :: mltype ! additive or multiplicative 2nd level prec character(len=16) :: smthpos ! side: pre, post, both smoothing integer(psb_ipk_) :: csize ! aggregation size at which to stop. @@ -186,8 +187,8 @@ program mld_d_pde3d type(precdata) :: prectype type(psb_d_coo_sparse_mat) :: acoo ! other variables - character(len=20) :: dump_prefix - logical :: dump_sol=.false., dump_prec=.false. + logical :: dump_prec + character(len=40) :: dump_prefix integer(psb_ipk_) :: info, i character(len=20) :: name,ch_err @@ -261,7 +262,7 @@ program mld_d_pde3d call mld_precset(prec,'aggr_kind', prectype%aggrkind,info) call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info) call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info) - call mld_precset(prec,'aggr_filter', mld_filter_mat_, info) + call mld_precset(prec,'aggr_filter', prectype%aggr_filter, info) call psb_barrier(ictxt) t1 = psb_wtime() @@ -448,6 +449,7 @@ contains call read_data(prectype%aggrkind,psb_inp_unit) ! smoothed/nonsmoothed/minenergy aggregatin call read_data(prectype%aggr_alg,psb_inp_unit) ! decoupled or sym. decoupled aggregation call read_data(prectype%aggr_ord,psb_inp_unit) ! aggregation ordering: natural, node degree + call read_data(prectype%aggr_filter,psb_inp_unit) ! aggregation filtering: filter, no_filter call read_data(prectype%mltype,psb_inp_unit) ! additive or multiplicative 2nd level prec call read_data(prectype%smthpos,psb_inp_unit) ! side: pre, post, both smoothing call read_data(prectype%jsweeps,psb_inp_unit) ! Smoother sweeps @@ -488,6 +490,7 @@ contains call psb_bcast(ictxt,prectype%aggrkind) ! smoothed/nonsmoothed/minenergy aggregatin call psb_bcast(ictxt,prectype%aggr_alg) ! decoupled or sym. decoupled aggregation call psb_bcast(ictxt,prectype%aggr_ord) ! aggregation ordering: natural, node degree + call psb_bcast(ictxt,prectype%aggr_filter) ! aggregation filtering: filter, no_filter call psb_bcast(ictxt,prectype%mltype) ! additive or multiplicative 2nd level prec call psb_bcast(ictxt,prectype%smthpos) ! side: pre, post, both smoothing call psb_bcast(ictxt,prectype%jsweeps) ! Smoother sweeps diff --git a/tests/pdegen/mld_s_pde2d.f90 b/tests/pdegen/mld_s_pde2d.f90 index 7627d389..7177c33c 100644 --- a/tests/pdegen/mld_s_pde2d.f90 +++ b/tests/pdegen/mld_s_pde2d.f90 @@ -1,8 +1,8 @@ !!!$ !!$ -!!$ MLD2P4 version 2.0 +!!$ MLD2P4 version 2.1 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package -!!$ based on PSBLAS (Parallel Sparse BLAS version 3.3) +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.4) !!$ !!$ (C) Copyright 2008, 2010, 2012, 2015 !!$ @@ -69,43 +69,43 @@ contains ! functions parametrizing the differential equation ! function b1(x,y) - use psb_base_mod, only : psb_spk_ + use psb_base_mod, only : psb_spk_,sone,szero real(psb_spk_) :: b1 real(psb_spk_), intent(in) :: x,y - b1=0.d0/sqrt(2.d0) + b1=szero/sqrt((2*sone)) end function b1 function b2(x,y) - use psb_base_mod, only : psb_spk_ + use psb_base_mod, only : psb_spk_,sone,szero real(psb_spk_) :: b2 real(psb_spk_), intent(in) :: x,y - b2=0.d0/sqrt(2.d0) + b2=szero/sqrt((2*sone)) end function b2 function c(x,y) - use psb_base_mod, only : psb_spk_ + use psb_base_mod, only : psb_spk_,sone,szero real(psb_spk_) :: c real(psb_spk_), intent(in) :: x,y - c=0.d0 + c=szero end function c function a1(x,y) - use psb_base_mod, only : psb_spk_ + use psb_base_mod, only : psb_spk_,sone,szero real(psb_spk_) :: a1 real(psb_spk_), intent(in) :: x,y - a1=1.d0!/80 + a1=sone!/80 end function a1 function a2(x,y) - use psb_base_mod, only : psb_spk_ + use psb_base_mod, only : psb_spk_,sone,szero real(psb_spk_) :: a2 real(psb_spk_), intent(in) :: x,y - a2=1.d0!/80 + a2=sone!/80 end function a2 function g(x,y) - use psb_base_mod, only : psb_spk_, done, dzero + use psb_base_mod, only : psb_spk_, sone, szero real(psb_spk_) :: g real(psb_spk_), intent(in) :: x,y - g = dzero - if (x == done) then - g = done - else if (x == dzero) then + g = szero + if (x == sone) then + g = sone + else if (x == szero) then g = exp(-y**2) end if end function g @@ -160,6 +160,7 @@ program mld_s_pde2d character(len=16) :: aggrkind ! smoothed/raw aggregatin character(len=16) :: aggr_alg ! local or global aggregation character(len=16) :: aggr_ord ! Ordering for aggregation + character(len=16) :: aggr_filter ! Use filtering? character(len=16) :: mltype ! additive or multiplicative 2nd level prec character(len=16) :: smthpos ! side: pre, post, both smoothing integer(psb_ipk_) :: csize ! aggregation size at which to stop. @@ -175,6 +176,8 @@ program mld_s_pde2d type(precdata) :: prectype type(psb_s_coo_sparse_mat) :: acoo ! other variables + logical :: dump_prec + character(len=40) :: dump_prefix integer(psb_ipk_) :: info, i character(len=20) :: name,ch_err @@ -203,7 +206,8 @@ program mld_s_pde2d ! ! get parameters ! - call get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst,eps) + call get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst,eps,& + & dump_prec,dump_prefix) ! ! allocate and fill in the coefficient matrix, rhs and initial guess @@ -241,11 +245,12 @@ program mld_s_pde2d if (prectype%mnaggratio>0)& & call mld_precset(prec,'min_aggr_ratio', prectype%mnaggratio, info) end if - if (prectype%athres >= dzero) & + if (prectype%athres >= szero) & & call mld_precset(prec,'aggr_thresh', prectype%athres, info) call mld_precset(prec,'aggr_kind', prectype%aggrkind,info) call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info) call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info) + call mld_precset(prec,'aggr_filter', prectype%aggr_filter, info) call psb_barrier(ictxt) t1 = psb_wtime() @@ -300,7 +305,7 @@ program mld_s_pde2d call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call psb_barrier(ictxt) - thier = dzero + thier = szero t1 = psb_wtime() call mld_precbld(a,desc_a,prec,info) if(info /= psb_success_) then @@ -368,6 +373,10 @@ program mld_s_pde2d write(psb_out_unit,'("Total memory occupation for PREC: ",i12)') precsize end if + if (dump_prec) call prec%dump(info,prefix=trim(dump_prefix),& + & ac=.true.,solver=.true.,smoother=.true.,rp=.true.,global_num=.true.) + + ! ! cleanup storage and exit ! @@ -392,13 +401,17 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst,eps) + subroutine get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst,eps,& + & dump_prec,dump_prefix) + integer(psb_ipk_) :: ictxt type(precdata) :: prectype character(len=*) :: kmethd, afmt integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst integer(psb_ipk_) :: np, iam, info real(psb_spk_) :: eps + logical :: dump_prec + character(len=*) :: dump_prefix character(len=20) :: buffer call psb_info(ictxt, iam, np) @@ -412,6 +425,8 @@ contains call read_data(itrace,psb_inp_unit) call read_data(irst,psb_inp_unit) call read_data(eps,psb_inp_unit) + call read_data(dump_prec,psb_inp_unit) + call read_data(dump_prefix,psb_inp_unit) call read_data(prectype%descr,psb_inp_unit) ! verbose description of the prec call read_data(prectype%prec,psb_inp_unit) ! overall prectype call read_data(prectype%nlevs,psb_inp_unit) ! Prescribed number of levels @@ -422,6 +437,7 @@ contains call read_data(prectype%aggrkind,psb_inp_unit) ! smoothed/nonsmoothed/minenergy aggregatin call read_data(prectype%aggr_alg,psb_inp_unit) ! decoupled or sym. decoupled aggregation call read_data(prectype%aggr_ord,psb_inp_unit) ! aggregation ordering: natural, node degree + call read_data(prectype%aggr_filter,psb_inp_unit) ! aggregation filtering: filter, no_filter call read_data(prectype%mltype,psb_inp_unit) ! additive or multiplicative 2nd level prec call read_data(prectype%smthpos,psb_inp_unit) ! side: pre, post, both smoothing call read_data(prectype%jsweeps,psb_inp_unit) ! Smoother sweeps @@ -450,6 +466,8 @@ contains call psb_bcast(ictxt,itrace) call psb_bcast(ictxt,irst) call psb_bcast(ictxt,eps) + call psb_bcast(ictxt,dump_prec) + call psb_bcast(ictxt,dump_prefix) call psb_bcast(ictxt,prectype%descr) ! verbose description of the prec call psb_bcast(ictxt,prectype%prec) ! overall prectype call psb_bcast(ictxt,prectype%nlevs) ! Prescribed number of levels @@ -460,6 +478,7 @@ contains call psb_bcast(ictxt,prectype%aggrkind) ! smoothed/nonsmoothed/minenergy aggregatin call psb_bcast(ictxt,prectype%aggr_alg) ! decoupled or sym. decoupled aggregation call psb_bcast(ictxt,prectype%aggr_ord) ! aggregation ordering: natural, node degree + call psb_bcast(ictxt,prectype%aggr_filter) ! aggregation filtering: filter, no_filter call psb_bcast(ictxt,prectype%mltype) ! additive or multiplicative 2nd level prec call psb_bcast(ictxt,prectype%smthpos) ! side: pre, post, both smoothing call psb_bcast(ictxt,prectype%jsweeps) ! Smoother sweeps diff --git a/tests/pdegen/mld_s_pde3d.f90 b/tests/pdegen/mld_s_pde3d.f90 index c2cb640e..7515522c 100644 --- a/tests/pdegen/mld_s_pde3d.f90 +++ b/tests/pdegen/mld_s_pde3d.f90 @@ -68,55 +68,55 @@ contains ! functions parametrizing the differential equation ! function b1(x,y,z) - use psb_base_mod, only : psb_spk_ + use psb_base_mod, only : psb_spk_,sone,szero real(psb_spk_) :: b1 real(psb_spk_), intent(in) :: x,y,z - b1=0.d0/sqrt(3.d0) + b1=szero/sqrt((3*sone)) end function b1 function b2(x,y,z) - use psb_base_mod, only : psb_spk_ + use psb_base_mod, only : psb_spk_,sone,szero real(psb_spk_) :: b2 real(psb_spk_), intent(in) :: x,y,z - b2=0.d0/sqrt(3.d0) + b2=szero/sqrt((3*sone)) end function b2 function b3(x,y,z) - use psb_base_mod, only : psb_spk_ + use psb_base_mod, only : psb_spk_,sone,szero real(psb_spk_) :: b3 real(psb_spk_), intent(in) :: x,y,z - b3=0.d0/sqrt(3.d0) + b3=szero/sqrt((3*sone)) end function b3 function c(x,y,z) - use psb_base_mod, only : psb_spk_ + use psb_base_mod, only : psb_spk_,sone,szero real(psb_spk_) :: c real(psb_spk_), intent(in) :: x,y,z - c=0.d0 + c=szero end function c function a1(x,y,z) - use psb_base_mod, only : psb_spk_ + use psb_base_mod, only : psb_spk_,sone,szero real(psb_spk_) :: a1 real(psb_spk_), intent(in) :: x,y,z - a1=1.d0!/80 + a1=sone!/80 end function a1 function a2(x,y,z) - use psb_base_mod, only : psb_spk_ + use psb_base_mod, only : psb_spk_,sone,szero real(psb_spk_) :: a2 real(psb_spk_), intent(in) :: x,y,z - a2=1.d0!/80 + a2=sone!/80 end function a2 function a3(x,y,z) - use psb_base_mod, only : psb_spk_ + use psb_base_mod, only : psb_spk_,sone,szero real(psb_spk_) :: a3 real(psb_spk_), intent(in) :: x,y,z - a3=1.d0!/80 + a3=sone!/80 end function a3 function g(x,y,z) - use psb_base_mod, only : psb_spk_, done, dzero + use psb_base_mod, only : psb_spk_,sone,szero real(psb_spk_) :: g real(psb_spk_), intent(in) :: x,y,z - g = dzero - if (x == done) then - g = done - else if (x == dzero) then + g = szero + if (x == sone) then + g = sone + else if (x == szero) then g = exp(y**2-z**2) end if end function g @@ -171,6 +171,7 @@ program mld_s_pde3d character(len=16) :: aggrkind ! smoothed/raw aggregatin character(len=16) :: aggr_alg ! local or global aggregation character(len=16) :: aggr_ord ! Ordering for aggregation + character(len=16) :: aggr_filter ! Use filtering? character(len=16) :: mltype ! additive or multiplicative 2nd level prec character(len=16) :: smthpos ! side: pre, post, both smoothing integer(psb_ipk_) :: csize ! aggregation size at which to stop. @@ -186,6 +187,8 @@ program mld_s_pde3d type(precdata) :: prectype type(psb_s_coo_sparse_mat) :: acoo ! other variables + logical :: dump_prec + character(len=40) :: dump_prefix integer(psb_ipk_) :: info, i character(len=20) :: name,ch_err @@ -214,7 +217,8 @@ program mld_s_pde3d ! ! get parameters ! - call get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst,eps) + call get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst,eps,& + &dump_prec,dump_prefix) ! ! allocate and fill in the coefficient matrix, rhs and initial guess @@ -253,11 +257,12 @@ program mld_s_pde3d if (prectype%mnaggratio>0)& & call mld_precset(prec,'min_aggr_ratio', prectype%mnaggratio, info) end if - if (prectype%athres >= dzero) & + if (prectype%athres >= szero) & & call mld_precset(prec,'aggr_thresh', prectype%athres, info) call mld_precset(prec,'aggr_kind', prectype%aggrkind,info) call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info) call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info) + call mld_precset(prec,'aggr_filter', prectype%aggr_filter, info) call psb_barrier(ictxt) t1 = psb_wtime() @@ -312,7 +317,7 @@ program mld_s_pde3d call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call psb_barrier(ictxt) - thier = dzero + thier = szero t1 = psb_wtime() call mld_precbld(a,desc_a,prec,info) if(info /= psb_success_) then @@ -380,6 +385,10 @@ program mld_s_pde3d write(psb_out_unit,'("Total memory occupation for PREC: ",i12)') precsize end if + if (dump_prec) call prec%dump(info,prefix=trim(dump_prefix),& + & ac=.true.,solver=.true.,smoother=.true.,rp=.true.,global_num=.true.) + + ! ! cleanup storage and exit ! @@ -404,13 +413,17 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst,eps) + subroutine get_parms(ictxt,kmethd,prectype,afmt,idim,istopc,itmax,itrace,irst,eps,& + & dump_prec,dump_prefix) + integer(psb_ipk_) :: ictxt type(precdata) :: prectype character(len=*) :: kmethd, afmt integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst integer(psb_ipk_) :: np, iam, info real(psb_spk_) :: eps + logical :: dump_prec + character(len=*) :: dump_prefix character(len=20) :: buffer call psb_info(ictxt, iam, np) @@ -424,6 +437,8 @@ contains call read_data(itrace,psb_inp_unit) call read_data(irst,psb_inp_unit) call read_data(eps,psb_inp_unit) + call read_data(dump_prec,psb_inp_unit) + call read_data(dump_prefix,psb_inp_unit) call read_data(prectype%descr,psb_inp_unit) ! verbose description of the prec call read_data(prectype%prec,psb_inp_unit) ! overall prectype call read_data(prectype%nlevs,psb_inp_unit) ! Prescribed number of levels @@ -434,6 +449,7 @@ contains call read_data(prectype%aggrkind,psb_inp_unit) ! smoothed/nonsmoothed/minenergy aggregatin call read_data(prectype%aggr_alg,psb_inp_unit) ! decoupled or sym. decoupled aggregation call read_data(prectype%aggr_ord,psb_inp_unit) ! aggregation ordering: natural, node degree + call read_data(prectype%aggr_filter,psb_inp_unit) ! aggregation filtering: filter, no_filter call read_data(prectype%mltype,psb_inp_unit) ! additive or multiplicative 2nd level prec call read_data(prectype%smthpos,psb_inp_unit) ! side: pre, post, both smoothing call read_data(prectype%jsweeps,psb_inp_unit) ! Smoother sweeps @@ -462,6 +478,8 @@ contains call psb_bcast(ictxt,itrace) call psb_bcast(ictxt,irst) call psb_bcast(ictxt,eps) + call psb_bcast(ictxt,dump_prec) + call psb_bcast(ictxt,dump_prefix) call psb_bcast(ictxt,prectype%descr) ! verbose description of the prec call psb_bcast(ictxt,prectype%prec) ! overall prectype call psb_bcast(ictxt,prectype%nlevs) ! Prescribed number of levels @@ -472,6 +490,7 @@ contains call psb_bcast(ictxt,prectype%aggrkind) ! smoothed/nonsmoothed/minenergy aggregatin call psb_bcast(ictxt,prectype%aggr_alg) ! decoupled or sym. decoupled aggregation call psb_bcast(ictxt,prectype%aggr_ord) ! aggregation ordering: natural, node degree + call psb_bcast(ictxt,prectype%aggr_filter) ! aggregation filtering: filter, no_filter call psb_bcast(ictxt,prectype%mltype) ! additive or multiplicative 2nd level prec call psb_bcast(ictxt,prectype%smthpos) ! side: pre, post, both smoothing call psb_bcast(ictxt,prectype%jsweeps) ! Smoother sweeps diff --git a/tests/pdegen/runs/ppde.inp b/tests/pdegen/runs/ppde.inp index f692ddef..2feabc54 100644 --- a/tests/pdegen/runs/ppde.inp +++ b/tests/pdegen/runs/ppde.inp @@ -1,6 +1,6 @@ BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG CSR ! Storage format CSR COO JAD -0100 ! IDIM; domain size is idim**3 +0080 ! IDIM; domain size is idim**3 2 ! ISTOPC 2000 ! ITMAX 10 ! ITRACE @@ -18,6 +18,7 @@ ML ! Preconditioner NONE JACOBI BJAC AS ML SMOOTHED ! Type of aggregation: SMOOTHED, UNSMOOTHED, MINENERGY DEC ! Type of aggregation: DEC SYMDEC NATURAL ! Ordering of aggregation: NATURAL DEGREE +FILTER ! Filtering aggregation: FILTER NO_FILTER MULT ! Type of multilevel correction: ADD MULT KCYCLE VCYCLE WCYCLE KCYCLESYM TWOSIDE ! Side of correction: PRE POST TWOSIDE (ignored for ADD) 2 ! Smoother sweeps @@ -25,13 +26,13 @@ BJAC ! Smoother type JACOBI BJAC AS; ignored for non-ML 0 ! Number of overlap layers for AS preconditioner (at finest level) HALO ! AS Restriction operator NONE HALO NONE ! AS Prolongation operator NONE SUM AVG -FWGS ! Subdomain solver DSCALE ILU MILU ILUT FWGS BWGS MUMPS UMF SLU +ILU ! Subdomain solver DSCALE ILU MILU ILUT FWGS BWGS MUMPS UMF SLU 1 ! Solver sweeps for GS 0 ! Level-set N for ILU(N), and P for ILUT 1.d-4 ! Threshold T for ILU(T,P) DIST ! Coarse level: matrix distribution DIST REPL BJAC ! Coarse level: solver JACOBI BJAC UMF SLU SLUDIST MUMPS -FWGS ! Coarse level: subsolver DSCALE GS BWGS ILU UMF SLU SLUDIST MUMPS -0 ! Coarse level: Level-set N for ILU(N) +ILU ! Coarse level: subsolver DSCALE GS BWGS ILU UMF SLU SLUDIST MUMPS +1 ! Coarse level: Level-set N for ILU(N) 1.d-4 ! Coarse level: Threshold T for ILU(T,P) 2 ! Coarse level: Number of Jacobi sweeps