fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

MLPREC directory: latest "aesthetic" fixes.

Browse Source
stopcriterion
Salvatore Filippone 17 years ago
parent 14b3d5c26d
commit 8f1096e6fd
14 changed files with 140 additions and 78 deletions
Show Stats Download Patch File Download Diff File

2
mlprec/mld_das_aply.f90
Unescape Escape View File

@ -113,7 +113,7 @@ subroutine mld_das_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
! Additive Schwarz preconditioner
!
if (prec%iprcparm(mld_n_ovr_)==0) then
if ((prec%iprcparm(mld_n_ovr_)==0).or.(np==1)) then
!
! Shortcut: this fixes performance for RAS(0) == BJA
!

6
mlprec/mld_das_bld.f90
Unescape Escape View File

@ -53,6 +53,12 @@
! p - type(mld_dbaseprc_type), input/output.
! The 'base preconditioner' data structure containing the local
! part of the preconditioner or solver to be built.
! upd - character, input.
! If upd='F' then the preconditioner is built from scratch;
! if upd=T' then the matrix to be preconditioned has the same
! sparsity pattern of a matrix that has been previously
! preconditioned, hence some information is reused in building
! the new preconditioner.
! info - integer, output.
! Error code.
!

6
mlprec/mld_dbaseprec_bld.f90
Unescape Escape View File

@ -60,6 +60,12 @@
! part of the preconditioner at the selected level.
! info - integer, output.
! Error code.
! upd - character, input, optional.
! If upd='F' then the base preconditioner is built from
! scratch; if upd=T' then the matrix to be preconditioned
! has the same sparsity pattern of a matrix that has been
! previously preconditioned, hence some information is reused
! in building the new preconditioner.
!
subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)

6
mlprec/mld_dbjac_bld.f90
Unescape Escape View File

@ -90,6 +90,12 @@
! part of the preconditioner or solver at the current level.
! info - integer, output.
! Error code.
! upd - character, input.
! If upd='F' then the preconditioner is built from scratch;
! if upd=T' then the matrix to be preconditioned has the same
! sparsity pattern of a matrix that has been previously
! preconditioned, hence some information is reused in building
! the new preconditioner.
! blck - type(psb_dspmat_type), input, optional.
! The sparse matrix structure containing the remote rows of the
! matrix to be factorized, that have been retrieved by mld_as_bld

4
mlprec/mld_dprecinit.f90
Unescape Escape View File

@ -97,7 +97,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
! Local variables
integer :: nlev_, ilev_
character(len=*), parameter :: name='mld_precinit'
info = 0
if (allocated(p%baseprecv)) then
@ -241,7 +241,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%dprcparm(mld_aggr_damp_) = 4.d0/3.d0
case default
write(0,*) 'Unknown preconditioner type request "',ptype,'"'
write(0,*) name,': Warning: Unknown preconditioner type request "',ptype,'"'
info = 2
end select

78
mlprec/mld_dprecset.f90
Unescape Escape View File

@ -83,11 +83,13 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
! Local variables
integer :: ilev_, nlev_
character(len=*), parameter :: name='mld_precseti'
info = 0
if (.not.allocated(p%baseprecv)) then
info = 3111
write(0,*) name,': Error: Uninitialized preconditioner, should call MLD_PRECINIT'
return
endif
nlev_ = size(p%baseprecv)
@ -100,10 +102,12 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(0,*) name,': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
info = 3111
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
return
endif
@ -117,49 +121,51 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
! Rules for fine level are slightly different.
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,mld_smooth_sweeps_)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,mld_smooth_sweeps_)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
else if (ilev_ > 1) then
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (ilev_ /= nlev_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fill_in_)
if (ilev_ /= nlev_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
@ -172,11 +178,12 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
& mld_smooth_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
@ -186,7 +193,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
& mld_smooth_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
@ -194,34 +201,34 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fill_in_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fill_in_) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
@ -278,6 +285,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
! Local variables
integer :: ilev_, nlev_,val
character(len=*), parameter :: name='mld_precseti'
info = 0
@ -294,11 +302,12 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
write(0,*) 'PRECSET ERRROR: ilev out of bounds'
write(0,*) name,': Error: invalid ILEV/NLEV combination',ilev_, nlev_
info = -1
return
endif
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = 3111
return
endif
@ -317,7 +326,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
call get_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
@ -331,7 +340,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
case(mld_coarse_mat_)
call get_stringval(string,val,info)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
@ -339,13 +348,13 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
case(mld_coarse_solve_)
call get_stringval(string,val,info)
if (ilev_ /= nlev_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
@ -361,7 +370,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
call get_stringval(string,val,info)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
@ -372,7 +381,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
call get_stringval(string,val,info)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
@ -380,7 +389,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
@ -388,14 +397,14 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
call get_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
@ -473,7 +482,7 @@ contains
info = -1
end select
if (info /= 0) then
write(0,*) 'Error in get_Stringval: unknown: "',trim(string),'"'
write(0,*) name,': Error: unknown request: "',trim(string),'"'
end if
end subroutine get_stringval
@ -527,6 +536,7 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
! Local variables
integer :: ilev_,nlev_
character(len=*), parameter :: name='mld_precsetd'
info = 0
@ -537,17 +547,19 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
end if
if (.not.allocated(p%baseprecv)) then
write(0,*) name,': Error: Uninitialized preconditioner, should call MLD_PRECINIT'
info = 3111
return
endif
nlev_ = size(p%baseprecv)
if ((ilev_<1).or.(ilev_ > nlev_)) then
write(0,*) 'PRECSET ERRROR: ilev out of bounds'
write(0,*) name,': Error: invalid ILEV/NLEV combination',ilev_, nlev_
info = -1
return
endif
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = 3111
return
endif
@ -565,7 +577,7 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
case(mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
@ -574,7 +586,7 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
case(mld_aggr_damp_,mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
@ -588,7 +600,7 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
case(mld_fact_thrs_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
@ -597,14 +609,14 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
case(mld_aggr_damp_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%dprcparm(what) = val
end do
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select

7
mlprec/mld_prec_type.f90
Unescape Escape View File

@ -236,8 +236,8 @@ module mld_prec_type
! Legal values for entry: mld_sub_ren_
!
integer, parameter :: mld_renum_none_=0, mld_renum_glb_=1, mld_renum_gps_=2
! For the time being we are disabling renumbering options.
integer, parameter :: mld_max_renum_=0
! For the time being we are disabling GPS renumbering...
integer, parameter :: mld_max_renum_=1
!
! Legal values for entry: mld_ml_type_
!
@ -252,7 +252,8 @@ module mld_prec_type
! Legal values for entry: mld_aggr_kind_
!
integer, parameter :: mld_no_smooth_=0, mld_smooth_prol_=1, mld_biz_prol_=2
integer, parameter :: mld_max_aggr_kind_=mld_biz_prol_
! Disabling biz_prol for the time being.
integer, parameter :: mld_max_aggr_kind_=mld_smooth_prol_
!
! Legal values for entry: mld_aggr_alg_
!

6
mlprec/mld_zas_bld.f90
Unescape Escape View File

@ -53,6 +53,12 @@
! p - type(mld_zbaseprc_type), input/output.
! The 'base preconditioner' data structure containing the local
! part of the preconditioner or solver to be built.
! upd - character, input.
! If upd='F' then the preconditioner is built from scratch;
! if upd=T' then the matrix to be preconditioned has the same
! sparsity pattern of a matrix that has been previously
! preconditioned, hence some information is reused in building
! the new preconditioner.
! info - integer, output.
! Error code.
!

6
mlprec/mld_zbaseprec_bld.f90
Unescape Escape View File

@ -60,6 +60,12 @@
! part of the preconditioner at the selected level.
! info - integer, output.
! Error code.
! upd - character, input, optional.
! If upd='F' then the base preconditioner is built from
! scratch; if upd=T' then the matrix to be preconditioned
! has the same sparsity pattern of a matrix that has been
! previously preconditioned, hence some information is reused
! in building the new preconditioner.
!
subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)

11
mlprec/mld_zbjac_bld.f90
Unescape Escape View File

@ -39,8 +39,8 @@
! Subroutine: mld_zbjac_bld
! Version: complex
!
! This routine computes an LU or incomplete LU factorization
! of the input matrix, according to the value of p%iprcparm(iprcparm(sub_solve_),
! This routine computes an LU or incomplete LU factorization of the input
! matrix, according to the value of p%iprcparm(iprcparm(sub_solve_),
! set by the user through mld_dprecinit or mld_dprecset.
! It may also split the local matrix into its block-diagonal and
! off block-diagonal parts, for the future application of multiple
@ -51,6 +51,7 @@
! or a block-Jacobi or LU or ILU solver at the coarsest level of a multilevel
! preconditioner. For the Additive Schwarz, it is called from mld_as_bld,
! which prepares the overlap descriptor and retrieves the remote rows into blck.
!
! More precisely, the routine performs one of the following tasks:
!
! 1. construction of a block-Jacobi preconditioner associated
@ -90,6 +91,12 @@
!
! info - integer, output.
! Error code.
! upd - character, input.
! If upd='F' then the preconditioner is built from scratch;
! if upd=T' then the matrix to be preconditioned has the same
! sparsity pattern of a matrix that has been previously
! preconditioned, hence some information is reused in building
! the new preconditioner.
! blck - type(psb_zspmat_type), input, optional.
! The sparse matrix structure containing the remote rows of the
! matrix to be factorized, that have been retrieved by mld_as_bld

4
mlprec/mld_zprecinit.f90
Unescape Escape View File

@ -97,7 +97,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
! Local variables
integer :: nlev_, ilev_
character(len=*), parameter :: name='mld_precinit'
info = 0
if (allocated(p%baseprecv)) then
@ -241,7 +241,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%dprcparm(mld_aggr_damp_) = 4.d0/3.d0
case default
write(0,*) 'Unknown preconditioner type request "',ptype,'"'
write(0,*) name,': Warning: Unknown preconditioner type request "',ptype,'"'
info = 2
end select

78
mlprec/mld_zprecset.f90
Unescape Escape View File

@ -83,11 +83,13 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
! Local variables
integer :: ilev_, nlev_
character(len=*), parameter :: name='mld_precseti'
info = 0
if (.not.allocated(p%baseprecv)) then
info = 3111
write(0,*) name,': Error: Uninitialized preconditioner, should call MLD_PRECINIT'
return
endif
nlev_ = size(p%baseprecv)
@ -100,10 +102,12 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(0,*) name,': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
info = 3111
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
return
endif
@ -117,49 +121,51 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
! Rules for fine level are slightly different.
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,mld_smooth_sweeps_)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,mld_smooth_sweeps_)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
else if (ilev_ > 1) then
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (ilev_ /= nlev_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fill_in_)
if (ilev_ /= nlev_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
@ -172,11 +178,12 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
& mld_smooth_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
@ -186,7 +193,7 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
& mld_smooth_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
@ -194,34 +201,34 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case(mld_coarse_sweeps_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fill_in_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fill_in_) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
@ -276,6 +283,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
! Local variables
integer :: ilev_, nlev_,val
character(len=*), parameter :: name='mld_precseti'
info = 0
@ -292,11 +300,12 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
write(0,*) 'PRECSET ERRROR: ilev out of bounds'
write(0,*) name,': Error: invalid ILEV/NLEV combination',ilev_, nlev_
info = -1
return
endif
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = 3111
return
endif
@ -315,7 +324,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
call get_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
@ -329,7 +338,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
case(mld_coarse_mat_)
call get_stringval(string,val,info)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
@ -337,13 +346,13 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
case(mld_coarse_solve_)
call get_stringval(string,val,info)
if (ilev_ /= nlev_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
@ -359,7 +368,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
call get_stringval(string,val,info)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
@ -370,7 +379,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
call get_stringval(string,val,info)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
@ -378,7 +387,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
@ -386,14 +395,14 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
call get_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
@ -471,7 +480,7 @@ contains
info = -1
end select
if (info /= 0) then
write(0,*) 'Error in get_Stringval: unknown: "',trim(string),'"'
write(0,*) name,': Error: unknown request: "',trim(string),'"'
end if
end subroutine get_stringval
end subroutine mld_zprecsetc
@ -523,6 +532,7 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
! Local variables
integer :: ilev_,nlev_
character(len=*), parameter :: name='mld_precsetd'
info = 0
@ -533,17 +543,19 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
end if
if (.not.allocated(p%baseprecv)) then
write(0,*) name,': Error: Uninitialized preconditioner, should call MLD_PRECINIT'
info = 3111
return
endif
nlev_ = size(p%baseprecv)
if ((ilev_<1).or.(ilev_ > nlev_)) then
write(0,*) 'PRECSET ERRROR: ilev out of bounds'
write(0,*) name,': Error: invalid ILEV/NLEV combination',ilev_, nlev_
info = -1
return
endif
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = 3111
return
endif
@ -561,7 +573,7 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
case(mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
@ -570,7 +582,7 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
case(mld_aggr_damp_,mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select
endif
@ -584,7 +596,7 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
case(mld_fact_thrs_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
@ -593,14 +605,14 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
case(mld_aggr_damp_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%dprcparm(what) = val
end do
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
write(0,*) name,': Error: invalid WHAT'
info = -2
end select

Write Preview
Loading…
Cancel
Save