mld2p4-2:

mlprec/mld_base_prec_type.f90
 mlprec/mld_d_as_smoother.f03
 mlprec/mld_d_jac_smoother.f03
 mlprec/mld_d_prec_type.f03
 mlprec/mld_dmlprec_aply.f90
 mlprec/mld_dmlprec_bld.f90
 mlprec/mld_dprecaply.f90
 mlprec/mld_dprecbld.f90
 mlprec/mld_dprecinit.F90
 mlprec/mld_dprecset.f90

Aligned constant names and defaults JAC vs. PJAC to MLD2P4 v1.2
stopcriterion
Salvatore Filippone 15 years ago
parent 6ebd4b4d49
commit 6b9a236dc8

@ -1,6 +1,6 @@
!!$ !!$
!!$ !!$
!!$ MLD2P4 version 1.1 !!$ MLD2P4 version 1.2
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 2.3.1) !!$ based on PSBLAS (Parallel Sparse BLAS version 2.3.1)
!!$ !!$
@ -36,13 +36,11 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! File: mld_prec_type.f90 ! File: mld_base_prec_type.f90
! !
! Module: mld_prec_type ! Module: mld_base_prec_type
! !
! This module defines: ! Constants and utilities in common to all type variants of MLD preconditioners.
! - the mld_prec_type data structure containing the preconditioner and related
! data structures;
! - integer constants defining the preconditioner; ! - integer constants defining the preconditioner;
! - character constants describing the preconditioner (used by the routines ! - character constants describing the preconditioner (used by the routines
! printing out a preconditioner description); ! printing out a preconditioner description);
@ -99,7 +97,6 @@ module mld_base_prec_type
integer, parameter :: mld_sub_ren_ = 5 integer, parameter :: mld_sub_ren_ = 5
integer, parameter :: mld_sub_ovr_ = 6 integer, parameter :: mld_sub_ovr_ = 6
integer, parameter :: mld_sub_fillin_ = 8 integer, parameter :: mld_sub_fillin_ = 8
integer, parameter :: mld_smoother_sweeps_ = 9
!! 2 ints for 64 bit versions !! 2 ints for 64 bit versions
integer, parameter :: mld_slu_ptr_ = 10 integer, parameter :: mld_slu_ptr_ = 10
integer, parameter :: mld_umf_symptr_ = 12 integer, parameter :: mld_umf_symptr_ = 12
@ -109,25 +106,28 @@ module mld_base_prec_type
! !
! These are in onelev ! These are in onelev
! !
integer, parameter :: mld_ml_type_ = 20 integer, parameter :: mld_ml_type_ = 20
integer, parameter :: mld_smoother_pos_ = 21 integer, parameter :: mld_smoother_sweeps_pre_ = 21
integer, parameter :: mld_aggr_kind_ = 22 integer, parameter :: mld_smoother_sweeps_post_ = 22
integer, parameter :: mld_aggr_alg_ = 23 integer, parameter :: mld_smoother_pos_ = 23
integer, parameter :: mld_aggr_omega_alg_ = 24 integer, parameter :: mld_aggr_kind_ = 24
integer, parameter :: mld_aggr_eig_ = 25 integer, parameter :: mld_aggr_alg_ = 25
integer, parameter :: mld_aggr_filter_ = 26 integer, parameter :: mld_aggr_omega_alg_ = 26
integer, parameter :: mld_coarse_mat_ = 27 integer, parameter :: mld_aggr_eig_ = 27
integer, parameter :: mld_coarse_solve_ = 28 integer, parameter :: mld_aggr_filter_ = 28
integer, parameter :: mld_coarse_sweeps_ = 29 integer, parameter :: mld_coarse_mat_ = 29
integer, parameter :: mld_coarse_fillin_ = 30 integer, parameter :: mld_coarse_solve_ = 30
integer, parameter :: mld_coarse_subsolve_ = 31 integer, parameter :: mld_coarse_sweeps_ = 31
integer, parameter :: mld_ifpsz_ = 32 integer, parameter :: mld_coarse_fillin_ = 32
integer, parameter :: mld_coarse_subsolve_ = 33
integer, parameter :: mld_smoother_sweeps_ = 34
integer, parameter :: mld_ifpsz_ = 36
! !
! Legal values for entry: mld_smoother_type_ ! Legal values for entry: mld_smoother_type_
! !
integer, parameter :: mld_min_prec_=0, mld_noprec_=0, mld_diag_=1, mld_bjac_=2,& integer, parameter :: mld_min_prec_=0, mld_noprec_=0, mld_jac_=1, mld_bjac_=2,&
& mld_as_=3, mld_pjac_=4, mld_max_prec_=4 & mld_as_=3, mld_max_prec_=3
! VERY IMPORTANT: we are relying on the following to be true: ! VERY IMPORTANT: we are relying on the following to be true:
! mld_pjac_ == mld_diag_scale_ ! mld_pjac_ == mld_diag_scale_
! mld_bjac_ == mld_milu_n_ (or mld_ilu_n_ would be fine) ! mld_bjac_ == mld_milu_n_ (or mld_ilu_n_ would be fine)
@ -136,8 +136,8 @@ module mld_base_prec_type
! !
! Legal values for entry: mld_sub_solve_ ! Legal values for entry: mld_sub_solve_
! !
integer, parameter :: mld_f_none_=0,mld_ilu_n_=1,mld_milu_n_=2, mld_ilu_t_=3 integer, parameter :: mld_f_none_=0, mld_diag_scale_=1, mld_ilu_n_=2, mld_milu_n_=3
integer, parameter :: mld_diag_scale_=4, mld_slu_=5, mld_umf_=6, mld_sludist_=7 integer, parameter :: mld_ilu_t_=4, mld_slu_=5, mld_umf_=6, mld_sludist_=7
integer, parameter :: mld_max_sub_solve_= 7 integer, parameter :: mld_max_sub_solve_= 7
! !
! Legal values for entry: mld_sub_ren_ ! Legal values for entry: mld_sub_ren_
@ -215,7 +215,7 @@ module mld_base_prec_type
character(len=19), parameter, private :: & character(len=19), parameter, private :: &
& eigen_estimates(0:0)=(/'infinity norm '/) & eigen_estimates(0:0)=(/'infinity norm '/)
character(len=19), parameter, private :: & character(len=19), parameter, private :: &
& smooth_names(1:3)=(/'pre-smoothing ','post-smoothing ',& & smooth_pos_names(1:3)=(/'pre-smoothing ','post-smoothing ',&
& 'pre/post-smoothing'/) & 'pre/post-smoothing'/)
character(len=15), parameter, private :: & character(len=15), parameter, private :: &
& aggr_kinds(0:3)=(/'nonsmoothed ','smoothed ',& & aggr_kinds(0:3)=(/'nonsmoothed ','smoothed ',&
@ -233,10 +233,10 @@ module mld_base_prec_type
& ml_names(0:3)=(/'none ','additive ','multiplicative',& & ml_names(0:3)=(/'none ','additive ','multiplicative',&
& 'new ML '/) & 'new ML '/)
character(len=15), parameter, private :: & character(len=15), parameter, private :: &
& fact_names(0:7)=(/'none ','ILU(n) ',& & fact_names(0:7)=(/'none ','Point Jacobi ','ILU(n) ',&
& 'MILU(n) ','ILU(t,n) ',& & 'MILU(n) ','ILU(t,n) ',&
& 'SuperLU ','UMFPACK LU ',& & 'UMFPACK LU ',&
& 'SuperLU_Dist ','DiagSc-PntJac '/) & 'SuperLU_Dist ','SuperLU '/)
interface mld_check_def interface mld_check_def
module procedure mld_icheck_def, mld_scheck_def, mld_dcheck_def module procedure mld_icheck_def, mld_scheck_def, mld_dcheck_def
@ -319,12 +319,12 @@ contains
val = mld_twoside_smooth_ val = mld_twoside_smooth_
case('NOPREC') case('NOPREC')
val = mld_noprec_ val = mld_noprec_
case('DIAG') !!$ case('DIAG')
val = mld_diag_ !!$ val = mld_diag_
case('BJAC') case('BJAC')
val = mld_bjac_ val = mld_bjac_
case('PJAC', 'JACOBI') case('JAC','JACOBI')
val = mld_pjac_ val = mld_jac_
case('AS') case('AS')
val = mld_as_ val = mld_as_
case('RENUM_NONE') case('RENUM_NONE')
@ -374,10 +374,8 @@ contains
select case(iprcparm(mld_smoother_type_)) select case(iprcparm(mld_smoother_type_))
case(mld_noprec_) case(mld_noprec_)
write(iout,*) ' No preconditioning' write(iout,*) ' No preconditioning'
case(mld_diag_) case(mld_jac_)
write(iout,*) ' Diagonal scaling' write(iout,*) ' Jacobi '
case(mld_pjac_)
write(iout,*) ' Point Jacobi '
case(mld_bjac_) case(mld_bjac_)
write(iout,*) ' Block Jacobi with ',& write(iout,*) ' Block Jacobi with ',&
& fact_names(iprcparm(mld_sub_solve_)) & fact_names(iprcparm(mld_sub_solve_))
@ -428,6 +426,7 @@ contains
integer, intent(out) :: info integer, intent(out) :: info
real(psb_spk_), intent(in), optional :: rprcparm(:) real(psb_spk_), intent(in), optional :: rprcparm(:)
real(psb_dpk_), intent(in), optional :: dprcparm(:) real(psb_dpk_), intent(in), optional :: dprcparm(:)
integer :: sweeps
info = 0 info = 0
if (count((/ present(rprcparm),present(dprcparm) /)) /= 1) then if (count((/ present(rprcparm),present(dprcparm) /)) /= 1) then
@ -441,7 +440,26 @@ contains
write(iout,*) ' Multilevel type: ',& write(iout,*) ' Multilevel type: ',&
& ml_names(iprcparm(mld_ml_type_)) & ml_names(iprcparm(mld_ml_type_))
write(iout,*) ' Smoother position: ',& write(iout,*) ' Smoother position: ',&
& smooth_names(iprcparm(mld_smoother_pos_)) & smooth_pos_names(iprcparm(mld_smoother_pos_))
if (iprcparm(mld_ml_type_) == mld_add_ml_) then
write(iout,*) ' Number of sweeps : ',&
& iprcparm(mld_smoother_sweeps_)
else
select case (iprcparm(mld_smoother_pos_))
case (mld_pre_smooth_)
write(iout,*) ' Number of sweeps : ',&
& iprcparm(mld_smoother_sweeps_pre_)
case (mld_post_smooth_)
write(iout,*) ' Number of sweeps : ',&
& iprcparm(mld_smoother_sweeps_post_)
case (mld_twoside_smooth_)
write(iout,*) ' Number of sweeps : pre: ',&
& iprcparm(mld_smoother_sweeps_pre_) ,&
& ' post: ',&
& iprcparm(mld_smoother_sweeps_post_)
end select
end if
write(iout,*) ' Aggregation: ', & write(iout,*) ' Aggregation: ', &
& aggr_names(iprcparm(mld_aggr_alg_)) & aggr_names(iprcparm(mld_aggr_alg_))
write(iout,*) ' Aggregation type: ', & write(iout,*) ' Aggregation type: ', &
@ -550,10 +568,18 @@ contains
end if end if
if (iprcparm(mld_coarse_mat_) == mld_distr_mat_ .and. & if (iprcparm(mld_coarse_mat_) == mld_distr_mat_ .and. &
& iprcparm(mld_sub_solve_) /= mld_sludist_) then & iprcparm(mld_sub_solve_) /= mld_sludist_) then
write(iout,*) ' Coarsest matrix solver: block Jacobi with ', & !!$ write(iout,*) ' Coarsest matrix solver: ',&
& fact_names(iprcparm2(mld_sub_solve_)) !!$ & smoother_names(iprcparm2(mld_smoother_type_))
write(iout,*) ' Number of Jacobi sweeps: ', & select case (iprcparm2(mld_smoother_type_))
& (iprcparm2(mld_smoother_sweeps_)) case(mld_bjac_,mld_as_)
write(iout,*) ' subdomain solver: ',&
& fact_names(iprcparm2(mld_sub_solve_))
write(iout,*) ' Number of smoother sweeps: ', &
& (iprcparm2(mld_smoother_sweeps_))
case(mld_jac_)
write(iout,*) ' Number of smoother sweeps: ', &
& (iprcparm2(mld_smoother_sweeps_))
end select
else else
write(iout,*) ' Coarsest matrix solver: ', & write(iout,*) ' Coarsest matrix solver: ', &
& fact_names(iprcparm2(mld_sub_solve_)) & fact_names(iprcparm2(mld_sub_solve_))
@ -837,8 +863,8 @@ contains
select case(iprec) select case(iprec)
case(mld_noprec_) case(mld_noprec_)
pr_to_str='NOPREC' pr_to_str='NOPREC'
case(mld_diag_) case(mld_jac_)
pr_to_str='DIAG' pr_to_str='JAC'
case(mld_bjac_) case(mld_bjac_)
pr_to_str='BJAC' pr_to_str='BJAC'
case(mld_as_) case(mld_as_)

@ -53,7 +53,7 @@ module mld_d_as_smoother
! !
type(psb_d_sparse_mat) :: nd type(psb_d_sparse_mat) :: nd
type(psb_desc_type) :: desc_data type(psb_desc_type) :: desc_data
integer :: novr, sweeps, restr, prol integer :: novr, restr, prol
contains contains
procedure, pass(sm) :: build => d_as_smoother_bld procedure, pass(sm) :: build => d_as_smoother_bld
procedure, pass(sm) :: apply => d_as_smoother_apply procedure, pass(sm) :: apply => d_as_smoother_apply
@ -79,7 +79,7 @@ module mld_d_as_smoother
contains contains
subroutine d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,work,info) subroutine d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
use psb_sparse_mod use psb_sparse_mod
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_d_as_smoother_type), intent(in) :: sm class(mld_d_as_smoother_type), intent(in) :: sm
@ -87,6 +87,7 @@ contains
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -154,7 +155,7 @@ contains
endif endif
if ((sm%novr == 0).and.(sm%sweeps == 1)) then if ((sm%novr == 0).and.(sweeps == 1)) then
! !
! Shortcut: in this case it's just the same ! Shortcut: in this case it's just the same
! as Block Jacobi. ! as Block Jacobi.
@ -173,7 +174,7 @@ contains
tx(nrow_d+1:isz) = dzero tx(nrow_d+1:isz) = dzero
if (sm%sweeps == 1) then if (sweeps == 1) then
select case(trans_) select case(trans_)
case('N') case('N')
@ -311,7 +312,7 @@ contains
else if (sm%sweeps > 1) then else if (sweeps > 1) then
! !
! !
@ -320,7 +321,7 @@ contains
! !
! !
ty = dzero ty = dzero
do i=1, sm%sweeps do i=1, sweeps
select case(trans_) select case(trans_)
case('N') case('N')
! !
@ -473,7 +474,7 @@ contains
info = 10 info = 10
call psb_errpush(info,name,& call psb_errpush(info,name,&
& i_err=(/2,sm%sweeps,0,0,0/)) & i_err=(/2,sweeps,0,0,0/))
goto 9999 goto 9999
@ -664,8 +665,8 @@ contains
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(what) select case(what)
case(mld_smoother_sweeps_) !!$ case(mld_smoother_sweeps_)
sm%sweeps = val !!$ sm%sweeps = val
case(mld_sub_ovr_) case(mld_sub_ovr_)
sm%novr = val sm%novr = val
case(mld_sub_restr_) case(mld_sub_restr_)
@ -834,7 +835,7 @@ contains
endif endif
write(iout_,*) ' Additive Schwarz with ',& write(iout_,*) ' Additive Schwarz with ',&
& sm%sweeps,' sweeps and ',sm%novr, ' overlap layers.' & sm%novr, ' overlap layers.'
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr) write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol) write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) ' Local solver:' write(iout_,*) ' Local solver:'

@ -52,7 +52,6 @@ module mld_d_jac_smoother
! class(mld_d_base_solver_type), allocatable :: sv ! class(mld_d_base_solver_type), allocatable :: sv
! !
type(psb_d_sparse_mat) :: nd type(psb_d_sparse_mat) :: nd
integer :: sweeps
contains contains
procedure, pass(sm) :: build => d_jac_smoother_bld procedure, pass(sm) :: build => d_jac_smoother_bld
procedure, pass(sm) :: apply => d_jac_smoother_apply procedure, pass(sm) :: apply => d_jac_smoother_apply
@ -74,7 +73,7 @@ module mld_d_jac_smoother
contains contains
subroutine d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,work,info) subroutine d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
use psb_sparse_mod use psb_sparse_mod
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_d_jac_smoother_type), intent(in) :: sm class(mld_d_jac_smoother_type), intent(in) :: sm
@ -82,6 +81,7 @@ contains
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -136,7 +136,7 @@ contains
end if end if
endif endif
if (sm%sweeps == 1) then if (sweeps == 1) then
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
@ -145,11 +145,11 @@ contains
goto 9999 goto 9999
endif endif
else if (sm%sweeps > 1) then else if (sweeps > 1) then
! !
! !
! Apply prec%iprcparm(mld_smoother_sweeps_) sweeps of a block-Jacobi solver ! Apply multiple sweeps of a block-Jacobi solver
! to compute an approximate solution of a linear system. ! to compute an approximate solution of a linear system.
! !
! !
@ -163,7 +163,7 @@ contains
tx = dzero tx = dzero
ty = dzero ty = dzero
do i=1, sm%sweeps do i=1, sweeps
! !
! Compute Y(j+1) = D^(-1)*(X-ND*Y(j)), where D and ND are the ! Compute Y(j+1) = D^(-1)*(X-ND*Y(j)), where D and ND are the
! block diagonal part and the remaining part of the local matrix ! block diagonal part and the remaining part of the local matrix
@ -198,7 +198,7 @@ contains
info = 10 info = 10
call psb_errpush(info,name,& call psb_errpush(info,name,&
& i_err=(/2,sm%sweeps,0,0,0/)) & i_err=(/2,sweeps,0,0,0/))
goto 9999 goto 9999
endif endif
@ -309,8 +309,8 @@ contains
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(what) select case(what)
case(mld_smoother_sweeps_) !!$ case(mld_smoother_sweeps_)
sm%sweeps = val !!$ sm%sweeps = val
case default case default
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%set(what,val,info) call sm%sv%set(what,val,info)
@ -472,8 +472,7 @@ contains
iout_ = 6 iout_ = 6
endif endif
write(iout_,*) ' Block Jacobi smoother with ',& write(iout_,*) ' Block Jacobi smoother '
& sm%sweeps,' sweeps.'
write(iout_,*) ' Local solver:' write(iout_,*) ' Local solver:'
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%descr(info,iout_) call sm%sv%descr(info,iout_)

@ -672,7 +672,7 @@ contains
end subroutine mld_dprec_free end subroutine mld_dprec_free
subroutine d_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,work,info) subroutine d_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
use psb_sparse_mod use psb_sparse_mod
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_d_base_smoother_type), intent(in) :: sm class(mld_d_base_smoother_type), intent(in) :: sm
@ -680,6 +680,7 @@ contains
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer, intent(out) :: info

@ -420,7 +420,8 @@ contains
! Local variables ! Local variables
integer :: ictxt,np,me,i, nr2l,nc2l,err_act integer :: ictxt,np,me,i, nr2l,nc2l,err_act
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
integer :: nlev, ilev integer :: nlev, ilev, sweeps
character(len=20) :: name character(len=20) :: name
name = 'inner_ml_aply' name = 'inner_ml_aply'
@ -479,13 +480,14 @@ contains
end if end if
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_)
!!$ call mld_baseprec_aply(done,p%precv(level)%prec,& !!$ call mld_baseprec_aply(done,p%precv(level)%prec,&
!!$ & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& !!$ & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,&
!!$ & p%precv(level)%base_desc, trans,work,info) !!$ & p%precv(level)%base_desc, trans,work,info)
call p%precv(level)%sm%apply(done,& call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,work,info) & p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= 0) goto 9999 if (info /= 0) goto 9999
@ -550,14 +552,17 @@ contains
& work=work,trans=trans) & work=work,trans=trans)
if (info /= 0) goto 9999 if (info /= 0) goto 9999
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_post_)
call p%precv(level)%sm%apply(done,& call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%x2l,done,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,done,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,work,info) & p%precv(level)%base_desc, trans,&
& sweeps,work,info)
else else
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_)
call p%precv(level)%sm%apply(done,& call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,work,info) & p%precv(level)%base_desc, trans,&
& sweeps,work,info)
end if end if
@ -583,10 +588,15 @@ contains
! !
! Apply the base preconditioner ! Apply the base preconditioner
! !
if (level < nlev) then
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_post_)
else
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_)
end if
call p%precv(level)%sm%apply(done,& call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,work,info) & p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= 0) goto 9999 if (info /= 0) goto 9999
@ -637,10 +647,15 @@ contains
! !
! Apply the base preconditioner ! Apply the base preconditioner
! !
if (level < nlev) then
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_pre_)
else
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_)
end if
call p%precv(level)%sm%apply(done,& call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,work,info) & p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= 0) goto 9999 if (info /= 0) goto 9999
@ -699,15 +714,17 @@ contains
& work=work,trans=trans) & work=work,trans=trans)
if (info /= 0) goto 9999 if (info /= 0) goto 9999
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_pre_)
call p%precv(level)%sm%apply(done,& call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%x2l,done,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,done,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,work,info) & p%precv(level)%base_desc, trans,&
& sweeps,work,info)
else else
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_)
call p%precv(level)%sm%apply(done,& call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,work,info) & p%precv(level)%base_desc, trans,&
& sweeps,work,info)
end if end if
case default case default
@ -744,10 +761,19 @@ contains
! !
! Apply the base preconditioner ! Apply the base preconditioner
! !
if (level < nlev) then
if (trans == 'N') then
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_pre_)
else
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_post_)
end if
else
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_)
end if
if (info == 0) call p%precv(level)%sm%apply(done,& if (info == 0) call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,work,info) & p%precv(level)%base_desc, trans,&
& sweeps,work,info)
! !
! Compute the residual (at all levels but the coarsest one) ! Compute the residual (at all levels but the coarsest one)
! and call recursively ! and call recursively
@ -782,11 +808,15 @@ contains
! !
! Apply the base preconditioner ! Apply the base preconditioner
! !
if (trans == 'N') then
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_post_)
else
sweeps = p%precv(level)%iprcparm(mld_smoother_sweeps_pre_)
end if
if (info == 0) call p%precv(level)%sm%apply(done,& if (info == 0) call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%tx,done,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%tx,done,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,work,info) & p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4001,name,a_err='Error: residual/baseprec_aply') call psb_errpush(4001,name,a_err='Error: residual/baseprec_aply')
goto 9999 goto 9999
@ -823,6 +853,5 @@ contains
end subroutine inner_ml_aply end subroutine inner_ml_aply
end subroutine mld_dmlprec_aply end subroutine mld_dmlprec_aply

@ -307,7 +307,11 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),& call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),&
& 'Eps',dzero,is_legal_fact_thrs) & 'Eps',dzero,is_legal_fact_thrs)
end select end select
call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),& call mld_check_def(p%precv(i)%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps)
call mld_check_def(p%precv(i)%iprcparm(mld_smoother_sweeps_pre_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps)
call mld_check_def(p%precv(i)%iprcparm(mld_smoother_sweeps_post_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps) & 'Jacobi sweeps',1,is_legal_jac_sweeps)
! !
@ -322,7 +326,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
endif endif
end if end if
select case (p%precv(i)%prec%iprcparm(mld_smoother_type_)) select case (p%precv(i)%prec%iprcparm(mld_smoother_type_))
case(mld_diag_, mld_bjac_, mld_pjac_) case(mld_bjac_, mld_jac_)
allocate(mld_d_jac_smoother_type :: p%precv(i)%sm, stat=info) allocate(mld_d_jac_smoother_type :: p%precv(i)%sm, stat=info)
case(mld_as_) case(mld_as_)
allocate(mld_d_as_smoother_type :: p%precv(i)%sm, stat=info) allocate(mld_d_as_smoother_type :: p%precv(i)%sm, stat=info)
@ -338,8 +342,6 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
call p%precv(i)%sm%set(mld_sub_restr_,p%precv(i)%prec%iprcparm(mld_sub_restr_),info) call p%precv(i)%sm%set(mld_sub_restr_,p%precv(i)%prec%iprcparm(mld_sub_restr_),info)
call p%precv(i)%sm%set(mld_sub_prol_,p%precv(i)%prec%iprcparm(mld_sub_prol_),info) call p%precv(i)%sm%set(mld_sub_prol_,p%precv(i)%prec%iprcparm(mld_sub_prol_),info)
call p%precv(i)%sm%set(mld_sub_ovr_,p%precv(i)%prec%iprcparm(mld_sub_ovr_),info) call p%precv(i)%sm%set(mld_sub_ovr_,p%precv(i)%prec%iprcparm(mld_sub_ovr_),info)
call p%precv(i)%sm%set(mld_smoother_sweeps_,&
& p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),info)
select case (p%precv(i)%prec%iprcparm(mld_sub_solve_)) select case (p%precv(i)%prec%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_,mld_ilu_t_) case(mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
@ -416,6 +418,35 @@ contains
! !
val = prec%iprcparm(mld_coarse_solve_) val = prec%iprcparm(mld_coarse_solve_)
select case (val) select case (val)
case(mld_jac_)
if (prec%prec%iprcparm(mld_sub_solve_) /= mld_diag_scale_) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%prec%iprcparm(mld_sub_solve_) = mld_diag_scale_
end if
prec%prec%iprcparm(mld_smoother_type_) = mld_jac_
case(mld_bjac_)
if ((prec%prec%iprcparm(mld_sub_solve_) == mld_diag_scale_).or.&
& ( prec%prec%iprcparm(mld_smoother_type_) /= mld_bjac_)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
!!$#if defined(HAVE_UMF_)
!!$ prec%prec%iprcparm(mld_sub_solve_) = mld_umf_
!!$#elif defined(HAVE_SLU_)
!!$ prec%prec%iprcparm(mld_sub_solve_) = mld_slu_
!!$#else
prec%prec%iprcparm(mld_sub_solve_) = mld_ilu_n_
!!$#endif
end if
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
case(mld_umf_, mld_slu_) case(mld_umf_, mld_slu_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.& if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then & (prec%prec%iprcparm(mld_sub_solve_) /= val)) then

@ -141,7 +141,8 @@ subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work)
! Number of levels = 1: apply the base preconditioner ! Number of levels = 1: apply the base preconditioner
! !
!!$ call mld_baseprec_aply(done,prec%precv(1)%prec,x,dzero,y,desc_data,trans_, work_,info) !!$ call mld_baseprec_aply(done,prec%precv(1)%prec,x,dzero,y,desc_data,trans_, work_,info)
call prec%precv(1)%sm%apply(done,x,dzero,y,desc_data,trans_, work_,info) call prec%precv(1)%sm%apply(done,x,dzero,y,desc_data,trans_,&
& prec%precv(1)%iprcparm(mld_smoother_sweeps_), work_,info)
else else
info = 4013 info = 4013
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&

@ -184,7 +184,7 @@ subroutine mld_dprecbld(a,desc_a,p,info)
call mld_check_def(p%precv(1)%prec%rprcparm(mld_sub_iluthrs_),& call mld_check_def(p%precv(1)%prec%rprcparm(mld_sub_iluthrs_),&
& 'Eps',dzero,is_legal_fact_thrs) & 'Eps',dzero,is_legal_fact_thrs)
end select end select
call mld_check_def(p%precv(1)%prec%iprcparm(mld_smoother_sweeps_),& call mld_check_def(p%precv(1)%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps) & 'Jacobi sweeps',1,is_legal_jac_sweeps)
!!$ !!$
!!$ call mld_baseprec_bld(p%precv(1)%base_a,p%precv(1)%base_desc,& !!$ call mld_baseprec_bld(p%precv(1)%base_a,p%precv(1)%base_desc,&
@ -201,7 +201,7 @@ subroutine mld_dprecbld(a,desc_a,p,info)
endif endif
end if end if
select case (p%precv(1)%prec%iprcparm(mld_smoother_type_)) select case (p%precv(1)%prec%iprcparm(mld_smoother_type_))
case(mld_diag_, mld_bjac_, mld_pjac_) case(mld_jac_, mld_bjac_)
allocate(mld_d_jac_smoother_type :: p%precv(1)%sm, stat=info) allocate(mld_d_jac_smoother_type :: p%precv(1)%sm, stat=info)
case(mld_as_) case(mld_as_)
allocate(mld_d_as_smoother_type :: p%precv(1)%sm, stat=info) allocate(mld_d_as_smoother_type :: p%precv(1)%sm, stat=info)
@ -217,8 +217,6 @@ subroutine mld_dprecbld(a,desc_a,p,info)
call p%precv(1)%sm%set(mld_sub_restr_,p%precv(1)%prec%iprcparm(mld_sub_restr_),info) call p%precv(1)%sm%set(mld_sub_restr_,p%precv(1)%prec%iprcparm(mld_sub_restr_),info)
call p%precv(1)%sm%set(mld_sub_prol_,p%precv(1)%prec%iprcparm(mld_sub_prol_),info) call p%precv(1)%sm%set(mld_sub_prol_,p%precv(1)%prec%iprcparm(mld_sub_prol_),info)
call p%precv(1)%sm%set(mld_sub_ovr_,p%precv(1)%prec%iprcparm(mld_sub_ovr_),info) call p%precv(1)%sm%set(mld_sub_ovr_,p%precv(1)%prec%iprcparm(mld_sub_ovr_),info)
call p%precv(1)%sm%set(mld_smoother_sweeps_,&
& p%precv(1)%prec%iprcparm(mld_smoother_sweeps_),info)
select case (p%precv(1)%prec%iprcparm(mld_sub_solve_)) select case (p%precv(1)%prec%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_,mld_ilu_t_) case(mld_ilu_n_,mld_milu_n_,mld_ilu_t_)

@ -51,6 +51,8 @@
! !
! 'DIAG' - diagonal preconditioner ! 'DIAG' - diagonal preconditioner
! !
! 'PJAC' - point Jacobi preconditioner
!
! 'BJAC' - block Jacobi preconditioner, with ILU(0) ! 'BJAC' - block Jacobi preconditioner, with ILU(0)
! on the local blocks ! on the local blocks
! !
@ -135,8 +137,11 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%precv(ilev_)%prec%iprcparm(mld_sub_ren_) = 0 p%precv(ilev_)%prec%iprcparm(mld_sub_ren_) = 0
p%precv(ilev_)%prec%iprcparm(mld_sub_ovr_) = 0 p%precv(ilev_)%prec%iprcparm(mld_sub_ovr_) = 0
p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = 1 p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_pre_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_post_) = 1
case ('DIAG') case ('JAC','DIAG','JACOBI')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(p%precv(nlev_),stat=info)
@ -149,13 +154,17 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%precv(ilev_)%rprcparm(:) = dzero p%precv(ilev_)%rprcparm(:) = dzero
p%precv(ilev_)%prec%iprcparm(:) = 0 p%precv(ilev_)%prec%iprcparm(:) = 0
p%precv(ilev_)%prec%rprcparm(:) = dzero p%precv(ilev_)%prec%rprcparm(:) = dzero
p%precv(ilev_)%prec%iprcparm(mld_smoother_type_) = mld_diag_ p%precv(ilev_)%prec%iprcparm(mld_smoother_type_) = mld_jac_
p%precv(ilev_)%prec%iprcparm(mld_sub_solve_) = mld_f_none_ p%precv(ilev_)%prec%iprcparm(mld_sub_solve_) = mld_diag_scale_
p%precv(ilev_)%prec%iprcparm(mld_sub_restr_) = psb_none_ p%precv(ilev_)%prec%iprcparm(mld_sub_restr_) = psb_none_
p%precv(ilev_)%prec%iprcparm(mld_sub_prol_) = psb_none_ p%precv(ilev_)%prec%iprcparm(mld_sub_prol_) = psb_none_
p%precv(ilev_)%prec%iprcparm(mld_sub_ren_) = 0 p%precv(ilev_)%prec%iprcparm(mld_sub_ren_) = 0
p%precv(ilev_)%prec%iprcparm(mld_sub_ovr_) = 0 p%precv(ilev_)%prec%iprcparm(mld_sub_ovr_) = 0
p%precv(ilev_)%prec%iprcparm(mld_sub_fillin_) = 0
p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = 1 p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_pre_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_post_) = 1
case ('BJAC') case ('BJAC')
nlev_ = 1 nlev_ = 1
@ -178,6 +187,9 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%precv(ilev_)%prec%iprcparm(mld_sub_ovr_) = 0 p%precv(ilev_)%prec%iprcparm(mld_sub_ovr_) = 0
p%precv(ilev_)%prec%iprcparm(mld_sub_fillin_) = 0 p%precv(ilev_)%prec%iprcparm(mld_sub_fillin_) = 0
p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = 1 p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_pre_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_post_) = 1
case ('AS') case ('AS')
nlev_ = 1 nlev_ = 1
@ -200,6 +212,9 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%precv(ilev_)%prec%iprcparm(mld_sub_ovr_) = 1 p%precv(ilev_)%prec%iprcparm(mld_sub_ovr_) = 1
p%precv(ilev_)%prec%iprcparm(mld_sub_fillin_) = 0 p%precv(ilev_)%prec%iprcparm(mld_sub_fillin_) = 0
p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = 1 p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_pre_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_post_) = 1
case ('ML') case ('ML')
@ -224,7 +239,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%precv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_ p%precv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
p%precv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_ p%precv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%precv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_ p%precv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%precv(ilev_)%iprcparm(mld_smoother_pos_) = mld_post_smooth_ p%precv(ilev_)%iprcparm(mld_smoother_pos_) = mld_twoside_smooth_
p%precv(ilev_)%iprcparm(mld_aggr_omega_alg_) = mld_eig_est_ p%precv(ilev_)%iprcparm(mld_aggr_omega_alg_) = mld_eig_est_
p%precv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_ p%precv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%precv(ilev_)%iprcparm(mld_aggr_filter_) = mld_no_filter_mat_ p%precv(ilev_)%iprcparm(mld_aggr_filter_) = mld_no_filter_mat_
@ -236,6 +251,9 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%precv(ilev_)%prec%iprcparm(mld_sub_ovr_) = 1 p%precv(ilev_)%prec%iprcparm(mld_sub_ovr_) = 1
p%precv(ilev_)%prec%iprcparm(mld_sub_fillin_) = 0 p%precv(ilev_)%prec%iprcparm(mld_sub_fillin_) = 0
p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = 1 p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_pre_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_post_) = 1
if (nlev_ == 1) return if (nlev_ == 1) return
do ilev_ = 2, nlev_ -1 do ilev_ = 2, nlev_ -1
@ -256,11 +274,14 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%precv(ilev_)%prec%iprcparm(mld_sub_solve_) = mld_ilu_n_ p%precv(ilev_)%prec%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%precv(ilev_)%prec%iprcparm(mld_sub_fillin_) = 0 p%precv(ilev_)%prec%iprcparm(mld_sub_fillin_) = 0
p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = 1 p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_pre_) = 1
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_post_) = 1
p%precv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_ p%precv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
p%precv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_ p%precv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
p%precv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_ p%precv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%precv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_ p%precv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%precv(ilev_)%iprcparm(mld_smoother_pos_) = mld_post_smooth_ p%precv(ilev_)%iprcparm(mld_smoother_pos_) = mld_twoside_smooth_
p%precv(ilev_)%iprcparm(mld_aggr_omega_alg_) = mld_eig_est_ p%precv(ilev_)%iprcparm(mld_aggr_omega_alg_) = mld_eig_est_
p%precv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_ p%precv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%precv(ilev_)%iprcparm(mld_aggr_filter_) = mld_no_filter_mat_ p%precv(ilev_)%iprcparm(mld_aggr_filter_) = mld_no_filter_mat_
@ -292,16 +313,18 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%precv(ilev_)%prec%iprcparm(mld_sub_ren_) = 0 p%precv(ilev_)%prec%iprcparm(mld_sub_ren_) = 0
p%precv(ilev_)%prec%iprcparm(mld_sub_ovr_) = 0 p%precv(ilev_)%prec%iprcparm(mld_sub_ovr_) = 0
p%precv(ilev_)%prec%iprcparm(mld_sub_fillin_) = 0 p%precv(ilev_)%prec%iprcparm(mld_sub_fillin_) = 0
p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = 4 p%precv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
p%precv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_ p%precv(ilev_)%iprcparm(mld_smoother_sweeps_) = 4
p%precv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_ p%precv(ilev_)%iprcparm(mld_smoother_sweeps_pre_) = 4
p%precv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_ p%precv(ilev_)%iprcparm(mld_smoother_sweeps_post_) = 4
p%precv(ilev_)%iprcparm(mld_smoother_pos_) = mld_post_smooth_ p%precv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
p%precv(ilev_)%iprcparm(mld_aggr_omega_alg_) = mld_eig_est_ p%precv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%precv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_ p%precv(ilev_)%iprcparm(mld_smoother_pos_) = mld_twoside_smooth_
p%precv(ilev_)%iprcparm(mld_aggr_filter_) = mld_no_filter_mat_ p%precv(ilev_)%iprcparm(mld_aggr_omega_alg_) = mld_eig_est_
p%precv(ilev_)%rprcparm(mld_aggr_omega_val_) = dzero p%precv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%precv(ilev_)%rprcparm(mld_aggr_thresh_) = dzero p%precv(ilev_)%iprcparm(mld_aggr_filter_) = mld_no_filter_mat_
p%precv(ilev_)%rprcparm(mld_aggr_omega_val_) = dzero
p%precv(ilev_)%rprcparm(mld_aggr_thresh_) = dzero
case default case default
write(0,*) name,': Warning: Unknown preconditioner type request "',ptype,'"' write(0,*) name,': Warning: Unknown preconditioner type request "',ptype,'"'

@ -143,11 +143,17 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
case(mld_smoother_type_) case(mld_smoother_type_)
p%precv(ilev_)%iprcparm(what) = val p%precv(ilev_)%iprcparm(what) = val
p%precv(ilev_)%prec%iprcparm(what) = val p%precv(ilev_)%prec%iprcparm(what) = val
case(mld_smoother_sweeps_)
p%precv(ilev_)%iprcparm(what) = val
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_pre_) = val
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_post_) = val
p%precv(ilev_)%prec%iprcparm(what) = val
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smoother_sweeps_) & mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_)
p%precv(ilev_)%prec%iprcparm(what) = val p%precv(ilev_)%prec%iprcparm(what) = val
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,& case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_omega_alg_,mld_aggr_eig_) & mld_smoother_pos_,mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_smoother_sweeps_pre_,mld_smoother_sweeps_post_)
p%precv(ilev_)%iprcparm(what) = val p%precv(ilev_)%iprcparm(what) = val
case default case default
write(0,*) name,': Error: invalid WHAT' write(0,*) name,': Error: invalid WHAT'
@ -159,12 +165,17 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
case(mld_smoother_type_) case(mld_smoother_type_)
p%precv(ilev_)%iprcparm(what) = val p%precv(ilev_)%iprcparm(what) = val
p%precv(ilev_)%prec%iprcparm(what) = val p%precv(ilev_)%prec%iprcparm(what) = val
case(mld_smoother_sweeps_)
p%precv(ilev_)%iprcparm(what) = val
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_pre_) = val
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_post_) = val
p%precv(ilev_)%prec%iprcparm(what) = val
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,& & mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_)
& mld_smoother_sweeps_)
p%precv(ilev_)%prec%iprcparm(what) = val p%precv(ilev_)%prec%iprcparm(what) = val
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,& case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_omega_alg_,mld_aggr_eig_) & mld_smoother_pos_,mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_smoother_sweeps_pre_,mld_smoother_sweeps_post_)
p%precv(ilev_)%iprcparm(what) = val p%precv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_) case(mld_coarse_mat_)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
@ -206,6 +217,9 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
return return
end if end if
p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = val p%precv(ilev_)%prec%iprcparm(mld_smoother_sweeps_) = val
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_) = val
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_pre_) = val
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_post_) = val
case(mld_coarse_fillin_) case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV' write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
@ -227,8 +241,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
! !
select case(what) select case(what)
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,& & mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_)
& mld_smoother_sweeps_)
do ilev_=1,max(1,nlev_-1) do ilev_=1,max(1,nlev_-1)
if (.not.allocated(p%precv(ilev_)%iprcparm)) then if (.not.allocated(p%precv(ilev_)%iprcparm)) then
write(0,*) name,& write(0,*) name,&
@ -239,6 +252,14 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
p%precv(ilev_)%iprcparm(what) = val p%precv(ilev_)%iprcparm(what) = val
p%precv(ilev_)%prec%iprcparm(what) = val p%precv(ilev_)%prec%iprcparm(what) = val
end do end do
case(mld_smoother_sweeps_)
do ilev_=1,max(1,nlev_-1)
p%precv(ilev_)%iprcparm(what) = val
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_pre_) = val
p%precv(ilev_)%iprcparm(mld_smoother_sweeps_post_) = val
p%precv(ilev_)%prec%iprcparm(what) = val
end do
case(mld_smoother_type_) case(mld_smoother_type_)
do ilev_=1,nlev_ do ilev_=1,nlev_
if (.not.allocated(p%precv(ilev_)%iprcparm)) then if (.not.allocated(p%precv(ilev_)%iprcparm)) then
@ -251,12 +272,13 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
p%precv(ilev_)%prec%iprcparm(what) = val p%precv(ilev_)%prec%iprcparm(what) = val
end do end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,& case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_omega_alg_,mld_aggr_eig_,mld_aggr_filter_) & mld_smoother_sweeps_pre_,mld_smoother_sweeps_post_,&
& mld_smoother_pos_,mld_aggr_omega_alg_,&
& mld_aggr_eig_,mld_aggr_filter_)
do ilev_=1,nlev_ do ilev_=1,nlev_
if (.not.allocated(p%precv(ilev_)%iprcparm)) then if (.not.allocated(p%precv(ilev_)%iprcparm)) then
write(0,*) name,& write(0,*) name,&
&': Error: uninitialized preconditioner component,',& &': Error: uninitialized preconditioner component, should call MLD_PRECINIT'
&' should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
@ -291,9 +313,9 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
p%precv(nlev_)%prec%iprcparm(mld_sub_solve_) = val p%precv(nlev_)%prec%iprcparm(mld_sub_solve_) = val
case(mld_sludist_) case(mld_sludist_)
p%precv(nlev_)%prec%iprcparm(mld_sub_solve_) = val p%precv(nlev_)%prec%iprcparm(mld_sub_solve_) = val
!!$ case(mld_jac_) case(mld_jac_)
!!$ p%precv(nlev_)%prec%iprcparm(mld_smoother_type_) = mld_jac_ p%precv(nlev_)%prec%iprcparm(mld_smoother_type_) = mld_jac_
!!$ p%precv(nlev_)%prec%iprcparm(mld_sub_solve_) = mld_diag_scale_ p%precv(nlev_)%prec%iprcparm(mld_sub_solve_) = mld_diag_scale_
end select end select
endif endif
case(mld_coarse_subsolve_) case(mld_coarse_subsolve_)
@ -314,7 +336,13 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
info = -1 info = -1
return return
endif endif
if (nlev_ > 1) p%precv(nlev_)%prec%iprcparm(mld_smoother_sweeps_) = val if (nlev_ > 1) then
p%precv(nlev_)%prec%iprcparm(mld_smoother_sweeps_) = val
p%precv(nlev_)%iprcparm(mld_smoother_sweeps_pre_) = val
p%precv(nlev_)%iprcparm(mld_smoother_sweeps_post_) = val
p%precv(nlev_)%prec%iprcparm(mld_smoother_sweeps_pre_) = val
p%precv(nlev_)%prec%iprcparm(mld_smoother_sweeps_post_) = val
end if
case(mld_coarse_fillin_) case(mld_coarse_fillin_)
if (.not.allocated(p%precv(nlev_)%iprcparm)) then if (.not.allocated(p%precv(nlev_)%iprcparm)) then
write(0,*) name,& write(0,*) name,&

Loading…
Cancel
Save