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

mld2p4:

Browse Source 
docs/pdf/gettingstarted.tex
 docs/pdf/overview.tex
 docs/pdf/userinterface.tex
 docs/userguide.pdf
 mlprec/mld_cas_aply.f90
 mlprec/mld_cas_bld.f90
 mlprec/mld_cbaseprec_aply.f90
 mlprec/mld_cbaseprec_bld.f90
 mlprec/mld_cilu_bld.f90
 mlprec/mld_cilut_fact.f90
 mlprec/mld_cmlprec_aply.f90
 mlprec/mld_cmlprec_bld.f90
 mlprec/mld_cprecinit.f90
 mlprec/mld_cprecset.f90
 mlprec/mld_das_aply.f90
 mlprec/mld_das_bld.f90
 mlprec/mld_dbaseprec_aply.f90
 mlprec/mld_dbaseprec_bld.f90
 mlprec/mld_dilu_bld.f90
 mlprec/mld_dilut_fact.f90
 mlprec/mld_dmlprec_aply.f90
 mlprec/mld_dmlprec_bld.f90
 mlprec/mld_dprecinit.f90
 mlprec/mld_dprecset.f90
 mlprec/mld_prec_type.f90
 mlprec/mld_sas_aply.f90
 mlprec/mld_sas_bld.f90
 mlprec/mld_sbaseprec_aply.f90
 mlprec/mld_sbaseprec_bld.f90
 mlprec/mld_silu_bld.f90
 mlprec/mld_silut_fact.f90
 mlprec/mld_smlprec_aply.f90
 mlprec/mld_smlprec_bld.f90
 mlprec/mld_sprecinit.f90
 mlprec/mld_sprecset.f90
 mlprec/mld_zas_aply.f90
 mlprec/mld_zas_bld.f90
 mlprec/mld_zbaseprec_aply.f90
 mlprec/mld_zbaseprec_bld.f90
 mlprec/mld_zilu_bld.f90
 mlprec/mld_zilut_fact.f90
 mlprec/mld_zmlprec_aply.f90
 mlprec/mld_zmlprec_bld.f90
 mlprec/mld_zprecinit.f90
 mlprec/mld_zprecset.f90
 test/fileread/cf_sample.f90
 test/fileread/df_bench.f90
 test/fileread/df_sample.f90
 test/fileread/sf_sample.f90
 test/fileread/zf_bench.f90
 test/fileread/zf_sample.f90
 test/pargen/ppde.f90
 test/pargen/spde.f90

Changed names of entris in iprcparm and updated documentation, take
1. Still missing: final fixes for coarse level.
stopcriterion
Salvatore Filippone 17 years ago
parent d4c258a204
commit 9bf85f340a
53 changed files with 1514 additions and 1727 deletions
Show Stats Download Patch File Download Diff File

13
docs/pdf/gettingstarted.tex
Unescape Escape View File

@ -41,9 +41,16 @@ The following steps are required:
A detailed description of the above routines is given in Section~\ref{sec:userinterface}.
Note that the Fortran 95 module \verb|mld_prec_mod| must be used in the program
calling the MLD2P4 routines. Furthermore, to apply MLD2P4 with the Krylov solvers
from PSBLAS, the module \verb|psb_krylov_mod| must be used too.
\textbf{DOBBIAMO SPECIFICARE QUALCHE ALTRO MODULO, AD ESEMPIO psb\_base\_mod?}
calling the MLD2P4 routines; this requires also the use of the
\verb|psb_base_mod| for the sparse matrix and communication descriptor
data types, as well as for the kind parameters for vectors, and the
use of the module \verb|psb_krylov_mod| for interfacing with the
Krylov solvers. Note that the include path for MLD2P4 must override
those for the base PSBLAS, e.g. they must come first in the sequence
passed to the compiler, as the MLD2P4 version of the Krylov interfaces
must override that of PSBLAS. This will change in the future when the
support for the \verb|class| statement becomes widespread in Fortran
compilers.
Examples showing the basic use of MLD2P4 are reported in Section~\ref{sec:examples}.
\noindent

13
docs/pdf/overview.tex
Unescape Escape View File

@ -28,10 +28,12 @@ discretization of a PDE). The \emph{smoothed aggregation} technique is applied
as algebraic coarsening strategy~\cite{BREZINA_VANEK,VANEK_MANDEL_BREZINA}.
\end{itemize}
The package is written in \emph{Fortran~95}, following an \emph{object-oriented approach}
through the exploitation of features such as abstract data type creation, functional
overloading and dynamic memory management, while providing a smooth path towards the integration in legacy application codes.
\textbf{NON MI PIACE QUESTO PERIODO, E' TROPPO LUNGO. RIUSCITE A SCRIVERLO MEGLIO?}
The package is written in \emph{Fortran~95}, following an
\emph{object-oriented approach} through the exploitation of features
such as abstract data type creation, functional
overloading and dynamic memory management.% , while providing a smooth
% path towards the integration in legacy application codes.
% \textbf{NON MI PIACE QUESTO PERIODO, E' TROPPO LUNGO. RIUSCITE A SCRIVERLO MEGLIO?}
The parallel implementation is based
on a Single Program Multiple Data (SPMD) paradigm for distributed-memory architectures.
Single and double precision implementations of MLD2P4 are available for both the
@ -39,7 +41,8 @@ real and the complex case, that can be used through a single interface.
MLD2P4 has been designed to implement scalable and easy-to-use multilevel preconditioners
in the context of the \emph{PSBLAS (Parallel Sparse BLAS) computational framework}~\cite{psblas_00}.
in the context of the \emph{PSBLAS (Parallel Sparse BLAS)
computational framework}~\cite{psblas_00}.
PSBLAS is a library originally developed to address the parallel implementation of
iterative solvers for sparse linear system, by providing basic linear algebra
operators and data management facilities for distributed sparse matrices; it

41
docs/pdf/userinterface.tex
Unescape Escape View File

@ -25,13 +25,13 @@ i.e.
\item the arrays containing the vectors $v$ and $w$ involved in
the preconditioner application $w=M^{-1}v$ must be of type
\emph{type}\verb|(|\emph{kind\_parameter}\verb|)|, with \emph{type} =
\verb|real|, \verb|complex| and \emph{kind\_parameter} = \verb|kind(1.)|,
\verb|real|, \verb|complex| and \emph{kind\_parameter} = \verb|kind(1.e0)|,
\verb|kind(1.d0)|, according to the sparse matrix and preconditioner
data structure; note that the PSBLAS module provides the constants \verb|psb_spk_|
= \verb|kind(1.)| and \verb|psb_dpk_| = \verb|kind(1.d0)|;
= \verb|kind(1.e0)| and \verb|psb_dpk_| = \verb|kind(1.d0)|;
\item real parameters defining the preconditioner must be declared
according to the precision of the previous data structures
(see Section \ref{sec:precset}).
(see Section~\ref{sec:precset}).
\end{itemize}
A description of each routine is given in the remainder of this section.
@ -88,7 +88,7 @@ contained in \verb|val|.
A mnemonic constant has been associated to each of these
numbers, as reported in Tables~\ref{tab:p_type}-\ref{tab:p_coarse}.\\
\verb|val | & \verb|integer| \emph{or} \verb|character(len=*)| \emph{or}
\verb|real(kind(1.))| \emph{or} \verb|real(kind(1.d0))|,
\verb|real(psb_spk_)| \emph{or} \verb|real(psb_dpk_)|,
\verb|intent(in)|.\\
& The value of the parameter to be set. The list of allowed
values and the corresponding data types is given in
@ -142,10 +142,7 @@ ACCESSIBILE ALL'UTENTE.}
& 'DIAG' \ \ \ 'BJAC' \ \ \ 'AS'
& 'AS'
& basic one-level preconditioner (i.e.\ smoother) of the
multi-level preconditioner
\textbf{CAMBIARE NOME COSTANTE NEL SW, ORA E'
mld\_prec\_type. INIBIRE no\_prec NELL'AMBITO DEL
MULTILEVEL.} \\
multi-level preconditioner \\
\verb|mld_smoother_pos_| & \verb|character(len=*)|
& 'PRE' \ \ \ 'POST' \ \ \ 'TWOSIDE'
& 'POST'
@ -168,7 +165,7 @@ ACCESSIBILE ALL'UTENTE.}
\verb|mld_sub_ovr| & \verb|integer|
& any number $\ge 0$
& 1
& \textbf{CAMBIARE NOME PARAMETRO NEL SW} number of overlap in the basic Schwarz preconditioner \\
& number of overlap in the basic Schwarz preconditioner \\
\verb|mld_sub_restr_| & \verb|character(len=*)|
& 'HALO' \ \ \ 'NONE'
& 'HALO'
@ -185,14 +182,13 @@ for incomplete LU with threshold, 'UMF' for complete LU using UMFPACK~\cite{UMFP
\verb|mld_sub_fillin_| & \verb|integer|
& any number $\ge 0$
& 0
& \textbf{CAMBIARE NOME PARAMETRO NEL SW} fill-in level for 'ILU', 'MILU' and 'ILUT' of local blocks\\
& fill-in level for 'ILU', 'MILU' and 'ILUT' of local blocks\\
\verb|mld_sub_thresh_| & \verb|real|
& any number $\ge 0.$
& 0.
& drop tolerance for 'ILUT'
\textbf{NELLA DOCUMENTAZIONE INTERNA DELLA ROUTINE DI FATTORIZZAZIONE C'E' INTERO, CAMBIARE!}\\
& drop tolerance for 'ILUT' \\
\verb|mld_sub_ren_| & \verb|character(len=*)|
& \textbf{MANCA COSTANTE STRINGA ASSOCIATA}
& 'RENUM\_NONE', 'RENUM\_GLOBAL' %, 'RENUM\_GPS'
&
& reordering algorithm for the local blocks \\
\hline
@ -223,10 +219,10 @@ for incomplete LU with threshold, 'UMF' for complete LU using UMFPACK~\cite{UMFP
& 0.
& dropping threshold in aggregation \\
\verb|mld_aggr_eig_| & \verb|character(len=*)|
& \textbf{MANCA STRINGA CORRISPONDENTE a mld\_max\_norm}
& 'ANORM'???
& 'A\_NORMI'
&
& define the algorithm to evaluate the maximum eigenvalue of $D^{-1}A$ for smoothed
aggregation. Now, only the A-norm of the matrix is available\\
aggregation. Currently only the infinity norm of the matrix A is available\\
\hline
\end{tabular}
\end{center}
@ -343,9 +339,10 @@ and hence is completely transparent to the user.
\verb|trans| & \verb|character(len=1), optional, intent(in).|\\
& If \verb|trans| = \verb|'N','n'| then $op(M^{-1}) = M^{-1}$;
if \verb|trans| = \verb|'T','t'| then $op(M^{-1}) = M^{-T}$
(transpose of $M^{-1})$.\\
(transpose of $M^{-1})$; if \verb|trans| = \verb|'C','c'| then $op(M^{-1}) = M^{-C}$
(conjugate transpose of $M^{-1})$.\\
\verb|work| & \emph{type}\verb|(|\emph{kind\_parameter}\verb|), dimension(:), optional, target|.\\
& Workspace. Its size must be at
& Workspace. Its size should be at
least \verb|4 * psb_cd_get_local_cols(desc_a)| (see the PSBLAS User's Guide).
Note that \emph{type} and \emph{kind\_parameter} must be chosen according
to the real/complex, single/double precision version of MLD2P4 under use.\\
@ -380,8 +377,7 @@ This routine deallocates the preconditioner data structure.
\noindent
This routine prints a description of the preconditioner
to the standard output or to a file.
\textbf{FARE UNA SOLA ROUTINE, COL PARAMETRO IOUT OPZIONALE.}
to a file.
\subsubsection*{Arguments}
@ -389,10 +385,9 @@ to the standard output or to a file.
\verb|p| & \verb|type(mld_|\emph{x}\verb|prec_type), intent(in)|.\\
& The preconditioner data structure. Note that \emph{x} must be chosen according
to the real/complex, single/double precision version of MLD2P4 under use.\\
\verb|iout| & \verb|integer, intent(in)|.\\
\verb|iout| & \verb|integer, intent(in), optional|.\\
& The id of the file where the preconditioner description
will be printed. If \verb|iout| is missing, the description is printed on
the standard output.\\
will be printed, default is standard output.\\
\end{tabular}
%%% Local Variables:

1822
docs/userguide.pdf
View File

File diff suppressed because it is too large Load Diff

6
mlprec/mld_cas_aply.f90
Unescape Escape View File

@ -108,7 +108,7 @@ subroutine mld_cas_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
trans_ = psb_toupper(trans)
select case(prec%iprcparm(mld_prec_type_))
select case(prec%iprcparm(mld_smoother_type_))
case(mld_bjac_)
@ -124,7 +124,7 @@ subroutine mld_cas_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
! Additive Schwarz preconditioner
!
if ((prec%iprcparm(mld_n_ovr_)==0).or.(np==1)) then
if ((prec%iprcparm(mld_sub_ovr_)==0).or.(np==1)) then
!
! Shortcut: this fixes performance for RAS(0) == BJA
!
@ -386,7 +386,7 @@ subroutine mld_cas_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
case default
call psb_errpush(4001,name,a_err='Invalid mld_prec_type_')
call psb_errpush(4001,name,a_err='Invalid mld_smoother_type_')
goto 9999
end select

4
mlprec/mld_cas_bld.f90
Unescape Escape View File

@ -110,8 +110,8 @@ subroutine mld_cas_bld(a,desc_a,p,upd,info)
n_col = psb_cd_get_local_cols(desc_a)
nnzero = psb_sp_get_nnzeros(a)
nhalo = n_col-n_row
ptype = p%iprcparm(mld_prec_type_)
novr = p%iprcparm(mld_n_ovr_)
ptype = p%iprcparm(mld_smoother_type_)
novr = p%iprcparm(mld_sub_ovr_)
select case (ptype)

4
mlprec/mld_cbaseprec_aply.f90
Unescape Escape View File

@ -121,7 +121,7 @@ subroutine mld_cbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
goto 9999
end select
select case(prec%iprcparm(mld_prec_type_))
select case(prec%iprcparm(mld_smoother_type_))
case(mld_noprec_)
!
@ -173,7 +173,7 @@ subroutine mld_cbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if
case default
call psb_errpush(4001,name,a_err='Invalid mld_prec_type_')
call psb_errpush(4001,name,a_err='Invalid mld_smoother_type_')
goto 9999
end select

10
mlprec/mld_cbaseprec_bld.f90
Unescape Escape View File

@ -122,13 +122,13 @@ subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd)
! Should add check to ensure all procs have the same...
!
call mld_check_def(p%iprcparm(mld_prec_type_),'base_prec',&
call mld_check_def(p%iprcparm(mld_smoother_type_),'base_prec',&
& mld_diag_,is_legal_base_prec)
call psb_nullify_desc(p%desc_data)
select case(p%iprcparm(mld_prec_type_))
select case(p%iprcparm(mld_smoother_type_))
case (mld_noprec_)
! No preconditioner
@ -159,7 +159,7 @@ subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd)
case(mld_bjac_,mld_as_)
! Additive Schwarz preconditioners/smoothers
call mld_check_def(p%iprcparm(mld_n_ovr_),'overlap',&
call mld_check_def(p%iprcparm(mld_sub_ovr_),'overlap',&
& 0,is_legal_n_ovr)
call mld_check_def(p%iprcparm(mld_sub_restr_),'restriction',&
& psb_halo_,is_legal_restrict)
@ -172,7 +172,7 @@ subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd)
! Set parameters for using SuperLU_dist on the local submatrices
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
p%iprcparm(mld_n_ovr_) = 0
p%iprcparm(mld_sub_ovr_) = 0
p%iprcparm(mld_smooth_sweeps_) = 1
end if
@ -191,7 +191,7 @@ subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd)
case default
info=4001
ch_err='Unknown mld_prec_type_'
ch_err='Unknown mld_smoother_type_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999

16
mlprec/mld_cilu_bld.f90
Unescape Escape View File

@ -66,7 +66,7 @@
! Arguments:
! a - type(psb_cspmat_type), input.
! The sparse matrix structure containing the local matrix.
! Note that if p%iprcparm(mld_n_ovr_) > 0, i.e. the
! Note that if p%iprcparm(mld_sub_ovr_) > 0, i.e. the
! 'base' Additive Schwarz preconditioner has overlap greater than
! 0, and p%iprcparm(mld_sub_ren_) = 0, i.e. a reordering of the
! matrix has not been performed (see mld_fact_bld), then a contains
@ -192,16 +192,16 @@ subroutine mld_cilu_bld(a,p,upd,info,blck)
! ILU(k,t)
!
select case(p%iprcparm(mld_sub_fill_in_))
select case(p%iprcparm(mld_sub_fillin_))
case(:-1)
! Error: fill-in <= -1
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fill_in_),0,0,0/))
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fillin_),0,0,0/))
goto 9999
case(0:)
! Fill-in >= 0
call mld_ilut_fact(p%iprcparm(mld_sub_fill_in_),p%rprcparm(mld_fact_thrs_),&
call mld_ilut_fact(p%iprcparm(mld_sub_fillin_),p%rprcparm(mld_fact_thrs_),&
& a, p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
end select
if(info/=0) then
@ -215,10 +215,10 @@ subroutine mld_cilu_bld(a,p,upd,info,blck)
!
! ILU(k) and MILU(k)
!
select case(p%iprcparm(mld_sub_fill_in_))
select case(p%iprcparm(mld_sub_fillin_))
case(:-1)
! Error: fill-in <= -1
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fill_in_),0,0,0/))
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fillin_),0,0,0/))
goto 9999
case(0)
! Fill-in 0
@ -230,13 +230,13 @@ subroutine mld_cilu_bld(a,p,upd,info,blck)
call mld_ilu0_fact(p%iprcparm(mld_sub_solve_),a,p%av(mld_l_pr_),p%av(mld_u_pr_),&
& p%d,info,blck=blck)
else
call mld_iluk_fact(p%iprcparm(mld_sub_fill_in_),p%iprcparm(mld_sub_solve_),&
call mld_iluk_fact(p%iprcparm(mld_sub_fillin_),p%iprcparm(mld_sub_solve_),&
& a,p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
endif
case(1:)
! Fill-in >= 1
! The same routine implements both ILU(k) and MILU(k)
call mld_iluk_fact(p%iprcparm(mld_sub_fill_in_),p%iprcparm(mld_sub_solve_),&
call mld_iluk_fact(p%iprcparm(mld_sub_fillin_),p%iprcparm(mld_sub_solve_),&
& a,p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
end select
if (info/=0) then

34
mlprec/mld_cilut_fact.f90
Unescape Escape View File

@ -61,7 +61,7 @@
! Arguments:
! fill_in - integer, input.
! The fill-in parameter k in ILU(k,t).
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! a - type(psb_cspmat_type), input.
! The sparse matrix structure containing the local matrix.
@ -101,7 +101,7 @@ subroutine mld_cilut_fact(fill_in,thres,a,l,u,d,info,blck)
! Arguments
integer, intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
real(psb_spk_), intent(in) :: thres
integer, intent(out) :: info
type(psb_cspmat_type),intent(in) :: a
type(psb_cspmat_type),intent(inout) :: l,u
@ -220,7 +220,7 @@ contains
! Arguments:
! fill_in - integer, input.
! The fill-in parameter k in ILU(k,t).
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! m - integer, output.
! The total number of rows of the local matrix to be factorized,
@ -273,11 +273,11 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in
integer, intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
type(psb_cspmat_type), intent(in) :: a,b
integer, intent(inout) :: m,l1,l2,info
integer, allocatable, intent(inout) :: lia1(:),lia2(:),uia1(:),uia2(:)
type(psb_cspmat_type), intent(in) :: a,b
integer, intent(inout) :: m,l1,l2,info
integer, allocatable, intent(inout) :: lia1(:),lia2(:),uia1(:),uia2(:)
complex(psb_spk_), allocatable, intent(inout) :: laspk(:),uaspk(:)
complex(psb_spk_), intent(inout) :: d(:)
@ -486,8 +486,8 @@ contains
type(psb_cspmat_type), intent(inout) :: trw
integer, intent(in) :: i, m,jmin,jmax,jd
integer, intent(inout) :: ktrw,nlw,nup,jmaxup,info
real(psb_spk_), intent(inout) :: nrmi
complex(psb_spk_), intent(inout) :: row(:)
real(psb_spk_), intent(inout) :: nrmi
complex(psb_spk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
integer :: k,j,irb,kin,nz
@ -624,7 +624,7 @@ contains
!
!
! Arguments
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! i - integer, input.
! The local index of the row to which the factorization is applied.
@ -679,10 +679,10 @@ contains
type(psb_int_heap), intent(inout) :: heap
integer, intent(in) :: i
integer, intent(inout) :: nidx,info
real(psb_spk_), intent(in) :: thres,nrmi
real(psb_spk_), intent(in) :: thres,nrmi
integer, allocatable, intent(inout) :: idxs(:)
integer, intent(inout) :: uia1(:),uia2(:)
complex(psb_spk_), intent(inout) :: row(:), uaspk(:),d(:)
complex(psb_spk_), intent(inout) :: row(:), uaspk(:),d(:)
! Local Variables
integer :: k,j,jj,lastk, iret
@ -796,7 +796,7 @@ contains
! Arguments:
! fill_in - integer, input.
! The fill-in parameter k in ILU(k,t).
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! i - integer, input.
! The local index of the row to be copied.
@ -862,10 +862,10 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer, intent(in) :: idxs(:)
integer, intent(inout) :: l1,l2, info
integer, allocatable, intent(inout) :: uia1(:),uia2(:), lia1(:),lia2(:)
integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer, intent(in) :: idxs(:)
integer, intent(inout) :: l1,l2, info
integer, allocatable, intent(inout) :: uia1(:),uia2(:), lia1(:),lia2(:)
real(psb_spk_), intent(in) :: thres,nrmi
complex(psb_spk_),allocatable, intent(inout) :: uaspk(:), laspk(:)
complex(psb_spk_), intent(inout) :: row(:), d(:)

4
mlprec/mld_cmlprec_aply.f90
Unescape Escape View File

@ -225,7 +225,7 @@ subroutine mld_cmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! Note that the transpose switches pre <-> post.
!
select case(baseprecv(2)%iprcparm(mld_smooth_pos_))
select case(baseprecv(2)%iprcparm(mld_smoother_pos_))
case(mld_post_smooth_)
@ -260,7 +260,7 @@ subroutine mld_cmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
case default
info = 4013
call psb_errpush(info,name,a_err='invalid smooth_pos',&
& i_Err=(/baseprecv(2)%iprcparm(mld_smooth_pos_),0,0,0,0/))
& i_Err=(/baseprecv(2)%iprcparm(mld_smoother_pos_),0,0,0,0/))
goto 9999
end select

4
mlprec/mld_cmlprec_bld.f90
Unescape Escape View File

@ -98,13 +98,13 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info)
& mld_smooth_prol_,is_legal_ml_aggr_kind)
call mld_check_def(p%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat)
call mld_check_def(p%iprcparm(mld_smooth_pos_),'smooth_pos',&
call mld_check_def(p%iprcparm(mld_smoother_pos_),'smooth_pos',&
& mld_pre_smooth_,is_legal_ml_smooth_pos)
select case(p%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%iprcparm(mld_sub_fill_in_),'Level',0,is_legal_ml_lev)
call mld_check_def(p%iprcparm(mld_sub_fillin_),'Level',0,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(p%rprcparm(mld_fact_thrs_),'Eps',szero,is_legal_s_fact_thrs)
end select

42
mlprec/mld_cprecinit.f90
Unescape Escape View File

@ -118,12 +118,12 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_noprec_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_noprec_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_f_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
case ('DIAG')
@ -134,12 +134,12 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_diag_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_diag_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_f_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
case ('BJAC')
@ -150,13 +150,13 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
case ('AS')
@ -167,13 +167,13 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_halo_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
@ -191,13 +191,13 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%rprcparm(:) = szero
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_halo_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
if (nlev_ == 1) return
@ -207,19 +207,19 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%rprcparm(:) = szero
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
p%baseprecv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%baseprecv(ilev_)%iprcparm(mld_smooth_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_smoother_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0
end do
@ -229,19 +229,19 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%rprcparm(:) = szero
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
p%baseprecv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%baseprecv(ilev_)%iprcparm(mld_smooth_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_smoother_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 4
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0

151
mlprec/mld_cprecset.f90
Unescape Escape View File

@ -123,8 +123,8 @@ subroutine mld_cprecseti(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_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smooth_sweeps_)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -133,10 +133,10 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
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_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
& mld_smoother_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
@ -159,13 +159,13 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
return
end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fill_in_)
case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = val
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
@ -180,8 +180,8 @@ subroutine mld_cprecseti(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_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
@ -192,7 +192,7 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
& mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
@ -222,13 +222,13 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fill_in_)
case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
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
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
@ -241,7 +241,7 @@ end subroutine mld_cprecseti
!
! Subroutine: mld_cprecsetc
! Version: complex
! Contains: get_stringval
! Contains: mld_stringval
!
! This routine sets the character parameters defining the preconditioner. More
! precisely, the character parameter identified by 'what' is assigned the value
@ -324,8 +324,8 @@ subroutine mld_cprecsetc(p,what,string,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_)
call get_stringval(string,val,info)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -334,13 +334,13 @@ subroutine mld_cprecsetc(p,what,string,info,ilev)
else if (ilev_ > 1) then
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
call get_stringval(string,val,info)
& mld_smoother_pos_,mld_aggr_eig_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
@ -348,7 +348,7 @@ subroutine mld_cprecsetc(p,what,string,info,ilev)
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
@ -368,8 +368,22 @@ subroutine mld_cprecsetc(p,what,string,info,ilev)
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call get_stringval(string,val,info)
case(mld_smoother_type_)
call mld_stringval(string,val,info)
if ((nlev_ > 1).and.(val==mld_noprec_)) then
write(0,*) name,': Error: invalid WHAT'
info = -2
endif
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
@ -379,8 +393,8 @@ subroutine mld_cprecsetc(p,what,string,info,ilev)
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_)
call get_stringval(string,val,info)
& mld_smoother_pos_)
call mld_stringval(string,val,info)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
@ -395,7 +409,7 @@ subroutine mld_cprecsetc(p,what,string,info,ilev)
info = -1
return
endif
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
@ -403,7 +417,7 @@ subroutine mld_cprecsetc(p,what,string,info,ilev)
info = -1
return
endif
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -412,91 +426,6 @@ subroutine mld_cprecsetc(p,what,string,info,ilev)
endif
contains
!
! Subroutine: get_stringval
! Note: internal subroutine of mld_dprecsetc
!
! This routine converts the string contained into string into the corresponding
! integer value.
!
! Arguments:
! string - character(len=*), input.
! The string to be converted.
! val - integer, output.
! The integer value corresponding to the string
! info - integer, output.
! Error code.
!
subroutine get_stringval(string,val,info)
! Arguments
character(len=*), intent(in) :: string
integer, intent(out) :: val, info
info = 0
select case(psb_toupper(trim(string)))
case('NONE')
val = 0
case('HALO')
val = psb_halo_
case('SUM')
val = psb_sum_
case('AVG')
val = psb_avg_
case('ILU')
val = mld_ilu_n_
case('MILU')
val = mld_milu_n_
case('ILUT')
val = mld_ilu_t_
case('UMF')
val = mld_umf_
case('SLU')
val = mld_slu_
case('SLUDIST')
val = mld_sludist_
case('ADD')
val = mld_add_ml_
case('MULT')
val = mld_mult_ml_
case('DEC')
val = mld_dec_aggr_
case('SYMDEC')
val = mld_sym_dec_aggr_
case('GLB')
val = mld_glb_aggr_
case('REPL')
val = mld_repl_mat_
case('DIST')
val = mld_distr_mat_
case('RAW')
val = mld_no_smooth_
case('SMOOTH')
val = mld_smooth_prol_
case('PRE')
val = mld_pre_smooth_
case('POST')
val = mld_post_smooth_
case('TWOSIDE','BOTH')
val = mld_twoside_smooth_
case('NOPREC')
val = mld_noprec_
case('DIAG')
val = mld_diag_
case('BJAC')
val = mld_bjac_
case('AS')
val = mld_as_
case default
val = -1
info = -1
end select
if (info /= 0) then
write(0,*) name,': Error: unknown request: "',trim(string),'"'
end if
end subroutine get_stringval
end subroutine mld_cprecsetc

6
mlprec/mld_das_aply.f90
Unescape Escape View File

@ -108,7 +108,7 @@ subroutine mld_das_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
trans_ = psb_toupper(trans)
select case(prec%iprcparm(mld_prec_type_))
select case(prec%iprcparm(mld_smoother_type_))
case(mld_bjac_)
@ -124,7 +124,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).or.(np==1)) then
if ((prec%iprcparm(mld_sub_ovr_)==0).or.(np==1)) then
!
! Shortcut: this fixes performance for RAS(0) == BJA
!
@ -386,7 +386,7 @@ subroutine mld_das_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
case default
call psb_errpush(4001,name,a_err='Invalid mld_prec_type_')
call psb_errpush(4001,name,a_err='Invalid mld_smoother_type_')
goto 9999
end select

4
mlprec/mld_das_bld.f90
Unescape Escape View File

@ -110,8 +110,8 @@ subroutine mld_das_bld(a,desc_a,p,upd,info)
n_col = psb_cd_get_local_cols(desc_a)
nnzero = psb_sp_get_nnzeros(a)
nhalo = n_col-n_row
ptype = p%iprcparm(mld_prec_type_)
novr = p%iprcparm(mld_n_ovr_)
ptype = p%iprcparm(mld_smoother_type_)
novr = p%iprcparm(mld_sub_ovr_)
select case (ptype)

4
mlprec/mld_dbaseprec_aply.f90
Unescape Escape View File

@ -121,7 +121,7 @@ subroutine mld_dbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
goto 9999
end select
select case(prec%iprcparm(mld_prec_type_))
select case(prec%iprcparm(mld_smoother_type_))
case(mld_noprec_)
!
@ -169,7 +169,7 @@ subroutine mld_dbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if
case default
call psb_errpush(4001,name,a_err='Invalid mld_prec_type_')
call psb_errpush(4001,name,a_err='Invalid mld_smoother_type_')
goto 9999
end select

10
mlprec/mld_dbaseprec_bld.f90
Unescape Escape View File

@ -122,13 +122,13 @@ subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)
! Should add check to ensure all procs have the same...
!
call mld_check_def(p%iprcparm(mld_prec_type_),'base_prec',&
call mld_check_def(p%iprcparm(mld_smoother_type_),'base_prec',&
& mld_diag_,is_legal_base_prec)
call psb_nullify_desc(p%desc_data)
select case(p%iprcparm(mld_prec_type_))
select case(p%iprcparm(mld_smoother_type_))
case (mld_noprec_)
! No preconditioner
@ -159,7 +159,7 @@ subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)
case(mld_bjac_,mld_as_)
! Additive Schwarz preconditioners/smoothers
call mld_check_def(p%iprcparm(mld_n_ovr_),'overlap',&
call mld_check_def(p%iprcparm(mld_sub_ovr_),'overlap',&
& 0,is_legal_n_ovr)
call mld_check_def(p%iprcparm(mld_sub_restr_),'restriction',&
& psb_halo_,is_legal_restrict)
@ -172,7 +172,7 @@ subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)
! Set parameters for using SuperLU_dist on the local submatrices
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
p%iprcparm(mld_n_ovr_) = 0
p%iprcparm(mld_sub_ovr_) = 0
p%iprcparm(mld_smooth_sweeps_) = 1
end if
@ -191,7 +191,7 @@ subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)
case default
info=4001
ch_err='Unknown mld_prec_type_'
ch_err='Unknown mld_smoother_type_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999

16
mlprec/mld_dilu_bld.f90
Unescape Escape View File

@ -66,7 +66,7 @@
! Arguments:
! a - type(psb_dspmat_type), input.
! The sparse matrix structure containing the local matrix.
! Note that if p%iprcparm(mld_n_ovr_) > 0, i.e. the
! Note that if p%iprcparm(mld_sub_ovr_) > 0, i.e. the
! 'base' Additive Schwarz preconditioner has overlap greater than
! 0, and p%iprcparm(mld_sub_ren_) = 0, i.e. a reordering of the
! matrix has not been performed (see mld_fact_bld), then a contains
@ -192,16 +192,16 @@ subroutine mld_dilu_bld(a,p,upd,info,blck)
! ILU(k,t)
!
select case(p%iprcparm(mld_sub_fill_in_))
select case(p%iprcparm(mld_sub_fillin_))
case(:-1)
! Error: fill-in <= -1
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fill_in_),0,0,0/))
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fillin_),0,0,0/))
goto 9999
case(0:)
! Fill-in >= 0
call mld_ilut_fact(p%iprcparm(mld_sub_fill_in_),p%rprcparm(mld_fact_thrs_),&
call mld_ilut_fact(p%iprcparm(mld_sub_fillin_),p%rprcparm(mld_fact_thrs_),&
& a, p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
end select
if(info/=0) then
@ -215,10 +215,10 @@ subroutine mld_dilu_bld(a,p,upd,info,blck)
!
! ILU(k) and MILU(k)
!
select case(p%iprcparm(mld_sub_fill_in_))
select case(p%iprcparm(mld_sub_fillin_))
case(:-1)
! Error: fill-in <= -1
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fill_in_),0,0,0/))
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fillin_),0,0,0/))
goto 9999
case(0)
! Fill-in 0
@ -230,13 +230,13 @@ subroutine mld_dilu_bld(a,p,upd,info,blck)
call mld_ilu0_fact(p%iprcparm(mld_sub_solve_),a,p%av(mld_l_pr_),p%av(mld_u_pr_),&
& p%d,info,blck=blck)
else
call mld_iluk_fact(p%iprcparm(mld_sub_fill_in_),p%iprcparm(mld_sub_solve_),&
call mld_iluk_fact(p%iprcparm(mld_sub_fillin_),p%iprcparm(mld_sub_solve_),&
& a,p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
endif
case(1:)
! Fill-in >= 1
! The same routine implements both ILU(k) and MILU(k)
call mld_iluk_fact(p%iprcparm(mld_sub_fill_in_),p%iprcparm(mld_sub_solve_),&
call mld_iluk_fact(p%iprcparm(mld_sub_fillin_),p%iprcparm(mld_sub_solve_),&
& a,p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
end select
if (info/=0) then

32
mlprec/mld_dilut_fact.f90
Unescape Escape View File

@ -61,7 +61,7 @@
! Arguments:
! fill_in - integer, input.
! The fill-in parameter k in ILU(k,t).
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! a - type(psb_dspmat_type), input.
! The sparse matrix structure containing the local matrix.
@ -101,7 +101,7 @@ subroutine mld_dilut_fact(fill_in,thres,a,l,u,d,info,blck)
! Arguments
integer, intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
real(psb_dpk_), intent(in) :: thres
integer, intent(out) :: info
type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u
@ -220,7 +220,7 @@ contains
! Arguments:
! fill_in - integer, input.
! The fill-in parameter k in ILU(k,t).
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! m - integer, output.
! The total number of rows of the local matrix to be factorized,
@ -273,11 +273,11 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in
integer, intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
type(psb_dspmat_type), intent(in) :: a,b
integer, intent(inout) :: m,l1,l2,info
integer, allocatable, intent(inout) :: lia1(:),lia2(:),uia1(:),uia2(:)
type(psb_dspmat_type), intent(in) :: a,b
integer, intent(inout) :: m,l1,l2,info
integer, allocatable, intent(inout) :: lia1(:),lia2(:),uia1(:),uia2(:)
real(psb_dpk_), allocatable, intent(inout) :: laspk(:),uaspk(:)
real(psb_dpk_), intent(inout) :: d(:)
@ -486,7 +486,7 @@ contains
type(psb_dspmat_type), intent(inout) :: trw
integer, intent(in) :: i, m,jmin,jmax,jd
integer, intent(inout) :: ktrw,nlw,nup,jmaxup,info
real(psb_dpk_), intent(inout) :: nrmi,row(:)
real(psb_dpk_), intent(inout) :: nrmi,row(:)
type(psb_int_heap), intent(inout) :: heap
integer :: k,j,irb,kin,nz
@ -623,7 +623,7 @@ contains
!
!
! Arguments
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! i - integer, input.
! The local index of the row to which the factorization is applied.
@ -678,10 +678,10 @@ contains
type(psb_int_heap), intent(inout) :: heap
integer, intent(in) :: i
integer, intent(inout) :: nidx,info
real(psb_dpk_), intent(in) :: thres,nrmi
real(psb_dpk_), intent(in) :: thres,nrmi
integer, allocatable, intent(inout) :: idxs(:)
integer, intent(inout) :: uia1(:),uia2(:)
real(psb_dpk_), intent(inout) :: row(:), uaspk(:),d(:)
real(psb_dpk_), intent(inout) :: row(:), uaspk(:),d(:)
! Local Variables
integer :: k,j,jj,lastk,iret
@ -795,7 +795,7 @@ contains
! Arguments:
! fill_in - integer, input.
! The fill-in parameter k in ILU(k,t).
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! i - integer, input.
! The local index of the row to be copied.
@ -861,10 +861,10 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer, intent(in) :: idxs(:)
integer, intent(inout) :: l1,l2, info
integer, allocatable, intent(inout) :: uia1(:),uia2(:), lia1(:),lia2(:)
integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer, intent(in) :: idxs(:)
integer, intent(inout) :: l1,l2, info
integer, allocatable, intent(inout) :: uia1(:),uia2(:), lia1(:),lia2(:)
real(psb_dpk_), intent(in) :: thres,nrmi
real(psb_dpk_),allocatable, intent(inout) :: uaspk(:), laspk(:)
real(psb_dpk_), intent(inout) :: row(:), d(:)

4
mlprec/mld_dmlprec_aply.f90
Unescape Escape View File

@ -225,7 +225,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! Note that the transpose switches pre <-> post.
!
select case(baseprecv(2)%iprcparm(mld_smooth_pos_))
select case(baseprecv(2)%iprcparm(mld_smoother_pos_))
case(mld_post_smooth_)
@ -260,7 +260,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
case default
info = 4013
call psb_errpush(info,name,a_err='invalid smooth_pos',&
& i_Err=(/baseprecv(2)%iprcparm(mld_smooth_pos_),0,0,0,0/))
& i_Err=(/baseprecv(2)%iprcparm(mld_smoother_pos_),0,0,0,0/))
goto 9999
end select

4
mlprec/mld_dmlprec_bld.f90
Unescape Escape View File

@ -98,13 +98,13 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
& mld_smooth_prol_,is_legal_ml_aggr_kind)
call mld_check_def(p%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat)
call mld_check_def(p%iprcparm(mld_smooth_pos_),'smooth_pos',&
call mld_check_def(p%iprcparm(mld_smoother_pos_),'smooth_pos',&
& mld_pre_smooth_,is_legal_ml_smooth_pos)
select case(p%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%iprcparm(mld_sub_fill_in_),'Level',0,is_legal_ml_lev)
call mld_check_def(p%iprcparm(mld_sub_fillin_),'Level',0,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(p%rprcparm(mld_fact_thrs_),'Eps',dzero,is_legal_fact_thrs)
end select

42
mlprec/mld_dprecinit.f90
Unescape Escape View File

@ -118,12 +118,12 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_noprec_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_noprec_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_f_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
case ('DIAG')
@ -134,12 +134,12 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_diag_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_diag_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_f_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
case ('BJAC')
@ -150,13 +150,13 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
case ('AS')
@ -167,13 +167,13 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_halo_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
@ -191,13 +191,13 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%rprcparm(:) = dzero
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_halo_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
if (nlev_ == 1) return
@ -207,19 +207,19 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%rprcparm(:) = dzero
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
p%baseprecv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%baseprecv(ilev_)%iprcparm(mld_smooth_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_smoother_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
end do
@ -229,19 +229,19 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%rprcparm(:) = dzero
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
p%baseprecv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%baseprecv(ilev_)%iprcparm(mld_smooth_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_smoother_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 4
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0

151
mlprec/mld_dprecset.f90
Unescape Escape View File

@ -123,8 +123,8 @@ 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_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smooth_sweeps_)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -133,10 +133,10 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
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_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
& mld_smoother_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
@ -159,13 +159,13 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
return
end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fill_in_)
case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = val
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
@ -180,8 +180,8 @@ 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_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
@ -192,7 +192,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
& mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
@ -222,13 +222,13 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fill_in_)
case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
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
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
@ -241,7 +241,7 @@ end subroutine mld_dprecseti
!
! Subroutine: mld_dprecsetc
! Version: real
! Contains: get_stringval
! Contains: mld_stringval
!
! This routine sets the character parameters defining the preconditioner. More
! precisely, the character parameter identified by 'what' is assigned the value
@ -324,8 +324,8 @@ subroutine mld_dprecsetc(p,what,string,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_)
call get_stringval(string,val,info)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -334,13 +334,13 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
else if (ilev_ > 1) then
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
call get_stringval(string,val,info)
& mld_smoother_pos_,mld_aggr_eig_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
@ -348,7 +348,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
@ -368,8 +368,22 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call get_stringval(string,val,info)
case(mld_smoother_type_)
call mld_stringval(string,val,info)
if ((nlev_ > 1).and.(val==mld_noprec_)) then
write(0,*) name,': Error: invalid WHAT'
info = -2
endif
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
@ -379,8 +393,8 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_)
call get_stringval(string,val,info)
& mld_smoother_pos_)
call mld_stringval(string,val,info)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
@ -395,7 +409,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
info = -1
return
endif
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
@ -403,7 +417,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
info = -1
return
endif
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -412,91 +426,6 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
endif
contains
!
! Subroutine: get_stringval
! Note: internal subroutine of mld_dprecsetc
!
! This routine converts the string contained into string into the corresponding
! integer value.
!
! Arguments:
! string - character(len=*), input.
! The string to be converted.
! val - integer, output.
! The integer value corresponding to the string
! info - integer, output.
! Error code.
!
subroutine get_stringval(string,val,info)
! Arguments
character(len=*), intent(in) :: string
integer, intent(out) :: val, info
info = 0
select case(psb_toupper(trim(string)))
case('NONE')
val = 0
case('HALO')
val = psb_halo_
case('SUM')
val = psb_sum_
case('AVG')
val = psb_avg_
case('ILU')
val = mld_ilu_n_
case('MILU')
val = mld_milu_n_
case('ILUT')
val = mld_ilu_t_
case('UMF')
val = mld_umf_
case('SLU')
val = mld_slu_
case('SLUDIST')
val = mld_sludist_
case('ADD')
val = mld_add_ml_
case('MULT')
val = mld_mult_ml_
case('DEC')
val = mld_dec_aggr_
case('SYMDEC')
val = mld_sym_dec_aggr_
case('GLB')
val = mld_glb_aggr_
case('REPL')
val = mld_repl_mat_
case('DIST')
val = mld_distr_mat_
case('RAW')
val = mld_no_smooth_
case('SMOOTH')
val = mld_smooth_prol_
case('PRE')
val = mld_pre_smooth_
case('POST')
val = mld_post_smooth_
case('TWOSIDE','BOTH')
val = mld_twoside_smooth_
case('NOPREC')
val = mld_noprec_
case('DIAG')
val = mld_diag_
case('BJAC')
val = mld_bjac_
case('AS')
val = mld_as_
case default
val = -1
info = -1
end select
if (info /= 0) then
write(0,*) name,': Error: unknown request: "',trim(string),'"'
end if
end subroutine get_stringval
end subroutine mld_dprecsetc

192
mlprec/mld_prec_type.f90
Unescape Escape View File

@ -236,33 +236,33 @@ module mld_prec_type
!
! Entries in iprcparm
!
integer, parameter :: mld_prec_type_=1
integer, parameter :: mld_sub_solve_=2
integer, parameter :: mld_sub_restr_=3
integer, parameter :: mld_sub_prol_=4
integer, parameter :: mld_sub_ren_=5
integer, parameter :: mld_n_ovr_=6
integer, parameter :: mld_sub_fill_in_=8
integer, parameter :: mld_smooth_sweeps_=9
integer, parameter :: mld_ml_type_=10
integer, parameter :: mld_smooth_pos_=11
integer, parameter :: mld_aggr_kind_=12
integer, parameter :: mld_aggr_alg_=13
integer, parameter :: mld_aggr_eig_=14
integer, parameter :: mld_coarse_mat_=16
integer, parameter :: mld_smoother_type_ = 1
integer, parameter :: mld_sub_solve_ = 2
integer, parameter :: mld_sub_restr_ = 3
integer, parameter :: mld_sub_prol_ = 4
integer, parameter :: mld_sub_ren_ = 5
integer, parameter :: mld_sub_ovr_ = 6
integer, parameter :: mld_sub_fillin_ = 8
integer, parameter :: mld_smooth_sweeps_ = 9
integer, parameter :: mld_ml_type_ = 10
integer, parameter :: mld_smoother_pos_ = 11
integer, parameter :: mld_aggr_kind_ = 12
integer, parameter :: mld_aggr_alg_ = 13
integer, parameter :: mld_aggr_eig_ = 14
integer, parameter :: mld_coarse_mat_ = 16
!! 2 ints for 64 bit versions
integer, parameter :: mld_slu_ptr_=17
integer, parameter :: mld_umf_symptr_=17
integer, parameter :: mld_umf_numptr_=19
integer, parameter :: mld_slud_ptr_=21
integer, parameter :: mld_prec_status_=24
integer, parameter :: mld_coarse_solve_ =25
integer, parameter :: mld_coarse_sweeps_ =26
integer, parameter :: mld_coarse_fill_in_=27
integer, parameter :: mld_ifpsz_=32
integer, parameter :: mld_slu_ptr_ = 17
integer, parameter :: mld_umf_symptr_ = 17
integer, parameter :: mld_umf_numptr_ = 19
integer, parameter :: mld_slud_ptr_ = 21
integer, parameter :: mld_prec_status_ = 24
integer, parameter :: mld_coarse_solve_ = 25
integer, parameter :: mld_coarse_sweeps_ = 26
integer, parameter :: mld_coarse_fillin_ = 27
integer, parameter :: mld_ifpsz_ = 32
!
! Legal values for entry: mld_prec_type_
! Legal values for entry: mld_smoother_type_
!
integer, parameter :: mld_min_prec_=0, mld_noprec_=0, mld_diag_=1, mld_bjac_=2,&
& mld_as_=3, mld_max_prec_=3
@ -283,7 +283,7 @@ module mld_prec_type
integer, parameter :: mld_no_ml_=0, mld_add_ml_=1, mld_mult_ml_=2
integer, parameter :: mld_new_ml_prec_=3, mld_max_ml_type_=mld_mult_ml_
!
! Legal values for entry: mld_smooth_pos_
! Legal values for entry: mld_smoother_pos_
!
integer, parameter :: mld_pre_smooth_=1, mld_post_smooth_=2,&
& mld_twoside_smooth_=3, mld_max_smooth_=mld_twoside_smooth_
@ -395,6 +395,100 @@ module mld_prec_type
contains
!
! Subroutine: mld_stringval
!
! This routine converts the string contained into string into the corresponding
! integer value.
!
! Arguments:
! string - character(len=*), input.
! The string to be converted.
! val - integer, output.
! The integer value corresponding to the string
! info - integer, output.
! Error code.
!
subroutine mld_stringval(string,val,info)
use psb_base_mod, only : psb_toupper
! Arguments
character(len=*), intent(in) :: string
integer, intent(out) :: val, info
info = 0
select case(psb_toupper(trim(string)))
case('NONE')
val = 0
case('HALO')
val = psb_halo_
case('SUM')
val = psb_sum_
case('AVG')
val = psb_avg_
case('ILU')
val = mld_ilu_n_
case('MILU')
val = mld_milu_n_
case('ILUT')
val = mld_ilu_t_
case('UMF')
val = mld_umf_
case('SLU')
val = mld_slu_
case('SLUDIST')
val = mld_sludist_
case('ADD')
val = mld_add_ml_
case('MULT')
val = mld_mult_ml_
case('DEC')
val = mld_dec_aggr_
case('SYMDEC')
val = mld_sym_dec_aggr_
case('GLB')
val = mld_glb_aggr_
case('REPL')
val = mld_repl_mat_
case('DIST')
val = mld_distr_mat_
case('RAW')
val = mld_no_smooth_
case('SMOOTH')
val = mld_smooth_prol_
case('PRE')
val = mld_pre_smooth_
case('POST')
val = mld_post_smooth_
case('TWOSIDE','BOTH')
val = mld_twoside_smooth_
case('NOPREC')
val = mld_noprec_
case('DIAG')
val = mld_diag_
case('BJAC')
val = mld_bjac_
case('AS')
val = mld_as_
case('RENUM_NONE')
val = mld_renum_none_
case('RENUM_GLOBAL')
val = mld_renum_glb_
case('RENUM_GPS')
val = mld_renum_gps_
case('A_NORMI')
val = mld_max_norm_
case('USER_CHOICE')
val = mld_user_choice_
case default
val = -1
info = -1
end select
if (info /= 0) then
write(0,*) name,': Error: unknown request: "',trim(string),'"'
end if
end subroutine mld_stringval
!
! Function returning the size of the mld_prec_type data structure
!
@ -639,7 +733,7 @@ contains
if (size(p%baseprecv)>=1) then
ilev = 1
write(iout_,*) 'Base preconditioner'
select case(p%baseprecv(ilev)%iprcparm(mld_prec_type_))
select case(p%baseprecv(ilev)%iprcparm(mld_smoother_type_))
case(mld_noprec_)
write(iout_,*) 'No preconditioning'
case(mld_diag_)
@ -649,7 +743,7 @@ contains
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
@ -661,7 +755,7 @@ contains
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
@ -669,7 +763,7 @@ contains
write(iout_,*) 'Should never get here!'
end select
write(iout_,*) 'Overlap:',&
& p%baseprecv(ilev)%iprcparm(mld_n_ovr_)
& p%baseprecv(ilev)%iprcparm(mld_sub_ovr_)
write(iout_,*) 'Restriction: ',&
& restrict_names(p%baseprecv(ilev)%iprcparm(mld_sub_restr_))
write(iout_,*) 'Prolongation: ',&
@ -697,7 +791,7 @@ contains
write(iout_,*) 'Damping omega: ', &
& p%baseprecv(ilev)%rprcparm(mld_aggr_damp_)
write(iout_,*) 'Multilevel smoother position: ',&
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smooth_pos_))
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smoother_pos_))
end if
write(iout_,*) 'Coarse matrix: ',&
& matrix_names(p%baseprecv(ilev)%iprcparm(mld_coarse_mat_))
@ -709,7 +803,7 @@ contains
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
@ -752,7 +846,7 @@ contains
if (size(p%baseprecv)>=1) then
ilev = 1
write(iout_,*) 'Base preconditioner'
select case(p%baseprecv(ilev)%iprcparm(mld_prec_type_))
select case(p%baseprecv(ilev)%iprcparm(mld_smoother_type_))
case(mld_noprec_)
write(iout_,*) 'No preconditioning'
case(mld_diag_)
@ -762,7 +856,7 @@ contains
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
@ -774,7 +868,7 @@ contains
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
@ -782,7 +876,7 @@ contains
write(iout_,*) 'Should never get here!'
end select
write(iout_,*) 'Overlap:',&
& p%baseprecv(ilev)%iprcparm(mld_n_ovr_)
& p%baseprecv(ilev)%iprcparm(mld_sub_ovr_)
write(iout_,*) 'Restriction: ',&
& restrict_names(p%baseprecv(ilev)%iprcparm(mld_sub_restr_))
write(iout_,*) 'Prolongation: ',&
@ -810,7 +904,7 @@ contains
write(iout_,*) 'Damping omega: ', &
& p%baseprecv(ilev)%rprcparm(mld_aggr_damp_)
write(iout_,*) 'Multilevel smoother position: ',&
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smooth_pos_))
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smoother_pos_))
end if
write(iout_,*) 'Coarse matrix: ',&
& matrix_names(p%baseprecv(ilev)%iprcparm(mld_coarse_mat_))
@ -822,7 +916,7 @@ contains
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
@ -885,7 +979,7 @@ contains
if (size(p%baseprecv)>=1) then
write(iout_,*) 'Base preconditioner'
ilev=1
select case(p%baseprecv(ilev)%iprcparm(mld_prec_type_))
select case(p%baseprecv(ilev)%iprcparm(mld_smoother_type_))
case(mld_noprec_)
write(iout_,*) 'No preconditioning'
case(mld_diag_)
@ -895,7 +989,7 @@ contains
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
@ -907,7 +1001,7 @@ contains
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
@ -915,7 +1009,7 @@ contains
write(iout_,*) 'Should never get here!'
end select
write(iout_,*) 'Overlap:',&
& p%baseprecv(ilev)%iprcparm(mld_n_ovr_)
& p%baseprecv(ilev)%iprcparm(mld_sub_ovr_)
write(iout_,*) 'Restriction: ',&
& restrict_names(p%baseprecv(ilev)%iprcparm(mld_sub_restr_))
write(iout_,*) 'Prolongation: ',&
@ -943,7 +1037,7 @@ contains
write(iout_,*) 'Smoothing omega: ', &
& p%baseprecv(ilev)%rprcparm(mld_aggr_damp_)
write(iout_,*) 'Smoothing position: ',&
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smooth_pos_))
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smoother_pos_))
end if
write(iout_,*) 'Coarse matrix: ',&
& matrix_names(p%baseprecv(ilev)%iprcparm(mld_coarse_mat_))
@ -955,7 +1049,7 @@ contains
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
@ -997,7 +1091,7 @@ contains
if (size(p%baseprecv)>=1) then
write(iout_,*) 'Base preconditioner'
ilev=1
select case(p%baseprecv(ilev)%iprcparm(mld_prec_type_))
select case(p%baseprecv(ilev)%iprcparm(mld_smoother_type_))
case(mld_noprec_)
write(iout_,*) 'No preconditioning'
case(mld_diag_)
@ -1007,7 +1101,7 @@ contains
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
@ -1019,7 +1113,7 @@ contains
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
@ -1027,7 +1121,7 @@ contains
write(iout_,*) 'Should never get here!'
end select
write(iout_,*) 'Overlap:',&
& p%baseprecv(ilev)%iprcparm(mld_n_ovr_)
& p%baseprecv(ilev)%iprcparm(mld_sub_ovr_)
write(iout_,*) 'Restriction: ',&
& restrict_names(p%baseprecv(ilev)%iprcparm(mld_sub_restr_))
write(iout_,*) 'Prolongation: ',&
@ -1055,7 +1149,7 @@ contains
write(iout_,*) 'Smoothing omega: ', &
& p%baseprecv(ilev)%rprcparm(mld_aggr_damp_)
write(iout_,*) 'Smoothing position: ',&
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smooth_pos_))
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smoother_pos_))
end if
write(iout_,*) 'Coarse matrix: ',&
& matrix_names(p%baseprecv(ilev)%iprcparm(mld_coarse_mat_))
@ -1067,7 +1161,7 @@ contains
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fillin_)
case(mld_ilu_t_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)

6
mlprec/mld_sas_aply.f90
Unescape Escape View File

@ -108,7 +108,7 @@ subroutine mld_sas_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
trans_ = psb_toupper(trans)
select case(prec%iprcparm(mld_prec_type_))
select case(prec%iprcparm(mld_smoother_type_))
case(mld_bjac_)
@ -124,7 +124,7 @@ subroutine mld_sas_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
! Additive Schwarz preconditioner
!
if ((prec%iprcparm(mld_n_ovr_)==0).or.(np==1)) then
if ((prec%iprcparm(mld_sub_ovr_)==0).or.(np==1)) then
!
! Shortcut: this fixes performance for RAS(0) == BJA
!
@ -386,7 +386,7 @@ subroutine mld_sas_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
case default
call psb_errpush(4001,name,a_err='Invalid mld_prec_type_')
call psb_errpush(4001,name,a_err='Invalid mld_smoother_type_')
goto 9999
end select

4
mlprec/mld_sas_bld.f90
Unescape Escape View File

@ -110,8 +110,8 @@ subroutine mld_sas_bld(a,desc_a,p,upd,info)
n_col = psb_cd_get_local_cols(desc_a)
nnzero = psb_sp_get_nnzeros(a)
nhalo = n_col-n_row
ptype = p%iprcparm(mld_prec_type_)
novr = p%iprcparm(mld_n_ovr_)
ptype = p%iprcparm(mld_smoother_type_)
novr = p%iprcparm(mld_sub_ovr_)
select case (ptype)

4
mlprec/mld_sbaseprec_aply.f90
Unescape Escape View File

@ -121,7 +121,7 @@ subroutine mld_sbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
goto 9999
end select
select case(prec%iprcparm(mld_prec_type_))
select case(prec%iprcparm(mld_smoother_type_))
case(mld_noprec_)
!
@ -169,7 +169,7 @@ subroutine mld_sbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if
case default
call psb_errpush(4001,name,a_err='Invalid mld_prec_type_')
call psb_errpush(4001,name,a_err='Invalid mld_smoother_type_')
goto 9999
end select

10
mlprec/mld_sbaseprec_bld.f90
Unescape Escape View File

@ -122,13 +122,13 @@ subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd)
! Should add check to ensure all procs have the same...
!
call mld_check_def(p%iprcparm(mld_prec_type_),'base_prec',&
call mld_check_def(p%iprcparm(mld_smoother_type_),'base_prec',&
& mld_diag_,is_legal_base_prec)
call psb_nullify_desc(p%desc_data)
select case(p%iprcparm(mld_prec_type_))
select case(p%iprcparm(mld_smoother_type_))
case (mld_noprec_)
! No preconditioner
@ -159,7 +159,7 @@ subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd)
case(mld_bjac_,mld_as_)
! Additive Schwarz preconditioners/smoothers
call mld_check_def(p%iprcparm(mld_n_ovr_),'overlap',&
call mld_check_def(p%iprcparm(mld_sub_ovr_),'overlap',&
& 0,is_legal_n_ovr)
call mld_check_def(p%iprcparm(mld_sub_restr_),'restriction',&
& psb_halo_,is_legal_restrict)
@ -172,7 +172,7 @@ subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd)
! Set parameters for using SuperLU_dist on the local submatrices
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
p%iprcparm(mld_n_ovr_) = 0
p%iprcparm(mld_sub_ovr_) = 0
p%iprcparm(mld_smooth_sweeps_) = 1
end if
@ -191,7 +191,7 @@ subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd)
case default
info=4001
ch_err='Unknown mld_prec_type_'
ch_err='Unknown mld_smoother_type_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999

16
mlprec/mld_silu_bld.f90
Unescape Escape View File

@ -66,7 +66,7 @@
! Arguments:
! a - type(psb_sspmat_type), input.
! The sparse matrix structure containing the local matrix.
! Note that if p%iprcparm(mld_n_ovr_) > 0, i.e. the
! Note that if p%iprcparm(mld_sub_ovr_) > 0, i.e. the
! 'base' Additive Schwarz preconditioner has overlap greater than
! 0, and p%iprcparm(mld_sub_ren_) = 0, i.e. a reordering of the
! matrix has not been performed (see mld_fact_bld), then a contains
@ -192,16 +192,16 @@ subroutine mld_silu_bld(a,p,upd,info,blck)
! ILU(k,t)
!
select case(p%iprcparm(mld_sub_fill_in_))
select case(p%iprcparm(mld_sub_fillin_))
case(:-1)
! Error: fill-in <= -1
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fill_in_),0,0,0/))
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fillin_),0,0,0/))
goto 9999
case(0:)
! Fill-in >= 0
call mld_ilut_fact(p%iprcparm(mld_sub_fill_in_),p%rprcparm(mld_fact_thrs_),&
call mld_ilut_fact(p%iprcparm(mld_sub_fillin_),p%rprcparm(mld_fact_thrs_),&
& a, p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
end select
if(info/=0) then
@ -215,10 +215,10 @@ subroutine mld_silu_bld(a,p,upd,info,blck)
!
! ILU(k) and MILU(k)
!
select case(p%iprcparm(mld_sub_fill_in_))
select case(p%iprcparm(mld_sub_fillin_))
case(:-1)
! Error: fill-in <= -1
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fill_in_),0,0,0/))
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fillin_),0,0,0/))
goto 9999
case(0)
! Fill-in 0
@ -230,13 +230,13 @@ subroutine mld_silu_bld(a,p,upd,info,blck)
call mld_ilu0_fact(p%iprcparm(mld_sub_solve_),a,p%av(mld_l_pr_),p%av(mld_u_pr_),&
& p%d,info,blck=blck)
else
call mld_iluk_fact(p%iprcparm(mld_sub_fill_in_),p%iprcparm(mld_sub_solve_),&
call mld_iluk_fact(p%iprcparm(mld_sub_fillin_),p%iprcparm(mld_sub_solve_),&
& a,p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
endif
case(1:)
! Fill-in >= 1
! The same routine implements both ILU(k) and MILU(k)
call mld_iluk_fact(p%iprcparm(mld_sub_fill_in_),p%iprcparm(mld_sub_solve_),&
call mld_iluk_fact(p%iprcparm(mld_sub_fillin_),p%iprcparm(mld_sub_solve_),&
& a,p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
end select
if (info/=0) then

32
mlprec/mld_silut_fact.f90
Unescape Escape View File

@ -61,7 +61,7 @@
! Arguments:
! fill_in - integer, input.
! The fill-in parameter k in ILU(k,t).
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! a - type(psb_sspmat_type), input.
! The sparse matrix structure containing the local matrix.
@ -101,7 +101,7 @@ subroutine mld_silut_fact(fill_in,thres,a,l,u,d,info,blck)
! Arguments
integer, intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
real(psb_spk_), intent(in) :: thres
integer, intent(out) :: info
type(psb_sspmat_type),intent(in) :: a
type(psb_sspmat_type),intent(inout) :: l,u
@ -220,7 +220,7 @@ contains
! Arguments:
! fill_in - integer, input.
! The fill-in parameter k in ILU(k,t).
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! m - integer, output.
! The total number of rows of the local matrix to be factorized,
@ -273,11 +273,11 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in
integer, intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
type(psb_sspmat_type), intent(in) :: a,b
integer, intent(inout) :: m,l1,l2,info
integer, allocatable, intent(inout) :: lia1(:),lia2(:),uia1(:),uia2(:)
type(psb_sspmat_type), intent(in) :: a,b
integer, intent(inout) :: m,l1,l2,info
integer, allocatable, intent(inout) :: lia1(:),lia2(:),uia1(:),uia2(:)
real(psb_spk_), allocatable, intent(inout) :: laspk(:),uaspk(:)
real(psb_spk_), intent(inout) :: d(:)
@ -486,7 +486,7 @@ contains
type(psb_sspmat_type), intent(inout) :: trw
integer, intent(in) :: i, m,jmin,jmax,jd
integer, intent(inout) :: ktrw,nlw,nup,jmaxup,info
real(psb_spk_), intent(inout) :: nrmi,row(:)
real(psb_spk_), intent(inout) :: nrmi,row(:)
type(psb_int_heap), intent(inout) :: heap
integer :: k,j,irb,kin,nz
@ -623,7 +623,7 @@ contains
!
!
! Arguments
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! i - integer, input.
! The local index of the row to which the factorization is applied.
@ -678,10 +678,10 @@ contains
type(psb_int_heap), intent(inout) :: heap
integer, intent(in) :: i
integer, intent(inout) :: nidx,info
real(psb_spk_), intent(in) :: thres,nrmi
real(psb_spk_), intent(in) :: thres,nrmi
integer, allocatable, intent(inout) :: idxs(:)
integer, intent(inout) :: uia1(:),uia2(:)
real(psb_spk_), intent(inout) :: row(:), uaspk(:),d(:)
real(psb_spk_), intent(inout) :: row(:), uaspk(:),d(:)
! Local Variables
integer :: k,j,jj,lastk,iret
@ -795,7 +795,7 @@ contains
! Arguments:
! fill_in - integer, input.
! The fill-in parameter k in ILU(k,t).
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! i - integer, input.
! The local index of the row to be copied.
@ -861,10 +861,10 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer, intent(in) :: idxs(:)
integer, intent(inout) :: l1,l2, info
integer, allocatable, intent(inout) :: uia1(:),uia2(:), lia1(:),lia2(:)
integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer, intent(in) :: idxs(:)
integer, intent(inout) :: l1,l2, info
integer, allocatable, intent(inout) :: uia1(:),uia2(:), lia1(:),lia2(:)
real(psb_spk_), intent(in) :: thres,nrmi
real(psb_spk_),allocatable, intent(inout) :: uaspk(:), laspk(:)
real(psb_spk_), intent(inout) :: row(:), d(:)

4
mlprec/mld_smlprec_aply.f90
Unescape Escape View File

@ -225,7 +225,7 @@ subroutine mld_smlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! Note that the transpose switches pre <-> post.
!
select case(baseprecv(2)%iprcparm(mld_smooth_pos_))
select case(baseprecv(2)%iprcparm(mld_smoother_pos_))
case(mld_post_smooth_)
@ -260,7 +260,7 @@ subroutine mld_smlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
case default
info = 4013
call psb_errpush(info,name,a_err='invalid smooth_pos',&
& i_Err=(/baseprecv(2)%iprcparm(mld_smooth_pos_),0,0,0,0/))
& i_Err=(/baseprecv(2)%iprcparm(mld_smoother_pos_),0,0,0,0/))
goto 9999
end select

4
mlprec/mld_smlprec_bld.f90
Unescape Escape View File

@ -98,13 +98,13 @@ subroutine mld_smlprec_bld(a,desc_a,p,info)
& mld_smooth_prol_,is_legal_ml_aggr_kind)
call mld_check_def(p%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat)
call mld_check_def(p%iprcparm(mld_smooth_pos_),'smooth_pos',&
call mld_check_def(p%iprcparm(mld_smoother_pos_),'smooth_pos',&
& mld_pre_smooth_,is_legal_ml_smooth_pos)
select case(p%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%iprcparm(mld_sub_fill_in_),'Level',0,is_legal_ml_lev)
call mld_check_def(p%iprcparm(mld_sub_fillin_),'Level',0,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(p%rprcparm(mld_fact_thrs_),'Eps',szero,is_legal_s_fact_thrs)
end select

42
mlprec/mld_sprecinit.f90
Unescape Escape View File

@ -118,12 +118,12 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_noprec_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_noprec_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_f_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
case ('DIAG')
@ -134,12 +134,12 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_diag_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_diag_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_f_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
case ('BJAC')
@ -150,13 +150,13 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
case ('AS')
@ -167,13 +167,13 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_halo_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
@ -191,13 +191,13 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%rprcparm(:) = szero
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_halo_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
if (nlev_ == 1) return
@ -207,19 +207,19 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%rprcparm(:) = szero
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
p%baseprecv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%baseprecv(ilev_)%iprcparm(mld_smooth_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_smoother_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0
end do
@ -229,19 +229,19 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%rprcparm(:) = szero
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
p%baseprecv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%baseprecv(ilev_)%iprcparm(mld_smooth_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_smoother_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 4
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.e0/3.e0

151
mlprec/mld_sprecset.f90
Unescape Escape View File

@ -123,8 +123,8 @@ subroutine mld_sprecseti(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_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smooth_sweeps_)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -133,10 +133,10 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
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_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
& mld_smoother_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
@ -159,13 +159,13 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
return
end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fill_in_)
case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = val
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
@ -180,8 +180,8 @@ subroutine mld_sprecseti(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_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
@ -192,7 +192,7 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
& mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
@ -222,13 +222,13 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fill_in_)
case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
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
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
@ -241,7 +241,7 @@ end subroutine mld_sprecseti
!
! Subroutine: mld_sprecsetc
! Version: real
! Contains: get_stringval
! Contains: mld_stringval
!
! This routine sets the character parameters defining the preconditioner. More
! precisely, the character parameter identified by 'what' is assigned the value
@ -324,8 +324,8 @@ subroutine mld_sprecsetc(p,what,string,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_)
call get_stringval(string,val,info)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -334,13 +334,13 @@ subroutine mld_sprecsetc(p,what,string,info,ilev)
else if (ilev_ > 1) then
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
call get_stringval(string,val,info)
& mld_smoother_pos_,mld_aggr_eig_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
@ -348,7 +348,7 @@ subroutine mld_sprecsetc(p,what,string,info,ilev)
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
@ -368,8 +368,22 @@ subroutine mld_sprecsetc(p,what,string,info,ilev)
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call get_stringval(string,val,info)
case(mld_smoother_type_)
call mld_stringval(string,val,info)
if ((nlev_ > 1).and.(val==mld_noprec_)) then
write(0,*) name,': Error: invalid WHAT'
info = -2
endif
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
@ -379,8 +393,8 @@ subroutine mld_sprecsetc(p,what,string,info,ilev)
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_)
call get_stringval(string,val,info)
& mld_smoother_pos_)
call mld_stringval(string,val,info)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
@ -395,7 +409,7 @@ subroutine mld_sprecsetc(p,what,string,info,ilev)
info = -1
return
endif
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
@ -403,7 +417,7 @@ subroutine mld_sprecsetc(p,what,string,info,ilev)
info = -1
return
endif
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -412,91 +426,6 @@ subroutine mld_sprecsetc(p,what,string,info,ilev)
endif
contains
!
! Subroutine: get_stringval
! Note: internal subroutine of mld_sprecsetc
!
! This routine converts the string contained into string into the corresponding
! integer value.
!
! Arguments:
! string - character(len=*), input.
! The string to be converted.
! val - integer, output.
! The integer value corresponding to the string
! info - integer, output.
! Error code.
!
subroutine get_stringval(string,val,info)
! Arguments
character(len=*), intent(in) :: string
integer, intent(out) :: val, info
info = 0
select case(psb_toupper(trim(string)))
case('NONE')
val = 0
case('HALO')
val = psb_halo_
case('SUM')
val = psb_sum_
case('AVG')
val = psb_avg_
case('ILU')
val = mld_ilu_n_
case('MILU')
val = mld_milu_n_
case('ILUT')
val = mld_ilu_t_
case('UMF')
val = mld_umf_
case('SLU')
val = mld_slu_
case('SLUDIST')
val = mld_sludist_
case('ADD')
val = mld_add_ml_
case('MULT')
val = mld_mult_ml_
case('DEC')
val = mld_dec_aggr_
case('SYMDEC')
val = mld_sym_dec_aggr_
case('GLB')
val = mld_glb_aggr_
case('REPL')
val = mld_repl_mat_
case('DIST')
val = mld_distr_mat_
case('RAW')
val = mld_no_smooth_
case('SMOOTH')
val = mld_smooth_prol_
case('PRE')
val = mld_pre_smooth_
case('POST')
val = mld_post_smooth_
case('TWOSIDE','BOTH')
val = mld_twoside_smooth_
case('NOPREC')
val = mld_noprec_
case('DIAG')
val = mld_diag_
case('BJAC')
val = mld_bjac_
case('AS')
val = mld_as_
case default
val = -1
info = -1
end select
if (info /= 0) then
write(0,*) name,': Error: unknown request: "',trim(string),'"'
end if
end subroutine get_stringval
end subroutine mld_sprecsetc

6
mlprec/mld_zas_aply.f90
Unescape Escape View File

@ -108,7 +108,7 @@ subroutine mld_zas_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
trans_ = psb_toupper(trans)
select case(prec%iprcparm(mld_prec_type_))
select case(prec%iprcparm(mld_smoother_type_))
case(mld_bjac_)
@ -124,7 +124,7 @@ subroutine mld_zas_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
! Additive Schwarz preconditioner
!
if ((prec%iprcparm(mld_n_ovr_)==0).or.(np==1)) then
if ((prec%iprcparm(mld_sub_ovr_)==0).or.(np==1)) then
!
! Shortcut: this fixes performance for RAS(0) == BJA
!
@ -386,7 +386,7 @@ subroutine mld_zas_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
case default
call psb_errpush(4001,name,a_err='Invalid mld_prec_type_')
call psb_errpush(4001,name,a_err='Invalid mld_smoother_type_')
goto 9999
end select

4
mlprec/mld_zas_bld.f90
Unescape Escape View File

@ -110,8 +110,8 @@ subroutine mld_zas_bld(a,desc_a,p,upd,info)
n_col = psb_cd_get_local_cols(desc_a)
nnzero = psb_sp_get_nnzeros(a)
nhalo = n_col-n_row
ptype = p%iprcparm(mld_prec_type_)
novr = p%iprcparm(mld_n_ovr_)
ptype = p%iprcparm(mld_smoother_type_)
novr = p%iprcparm(mld_sub_ovr_)
select case (ptype)

4
mlprec/mld_zbaseprec_aply.f90
Unescape Escape View File

@ -121,7 +121,7 @@ subroutine mld_zbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
goto 9999
end select
select case(prec%iprcparm(mld_prec_type_))
select case(prec%iprcparm(mld_smoother_type_))
case(mld_noprec_)
!
@ -173,7 +173,7 @@ subroutine mld_zbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if
case default
call psb_errpush(4001,name,a_err='Invalid mld_prec_type_')
call psb_errpush(4001,name,a_err='Invalid mld_smoother_type_')
goto 9999
end select

10
mlprec/mld_zbaseprec_bld.f90
Unescape Escape View File

@ -122,13 +122,13 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
! Should add check to ensure all procs have the same...
!
call mld_check_def(p%iprcparm(mld_prec_type_),'base_prec',&
call mld_check_def(p%iprcparm(mld_smoother_type_),'base_prec',&
& mld_diag_,is_legal_base_prec)
call psb_nullify_desc(p%desc_data)
select case(p%iprcparm(mld_prec_type_))
select case(p%iprcparm(mld_smoother_type_))
case (mld_noprec_)
! No preconditioner
@ -159,7 +159,7 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
case(mld_bjac_,mld_as_)
! Additive Schwarz preconditioners/smoothers
call mld_check_def(p%iprcparm(mld_n_ovr_),'overlap',&
call mld_check_def(p%iprcparm(mld_sub_ovr_),'overlap',&
& 0,is_legal_n_ovr)
call mld_check_def(p%iprcparm(mld_sub_restr_),'restriction',&
& psb_halo_,is_legal_restrict)
@ -172,7 +172,7 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
! Set parameters for using SuperLU_dist on the local submatrices
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
p%iprcparm(mld_n_ovr_) = 0
p%iprcparm(mld_sub_ovr_) = 0
p%iprcparm(mld_smooth_sweeps_) = 1
end if
@ -191,7 +191,7 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
case default
info=4001
ch_err='Unknown mld_prec_type_'
ch_err='Unknown mld_smoother_type_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999

16
mlprec/mld_zilu_bld.f90
Unescape Escape View File

@ -66,7 +66,7 @@
! Arguments:
! a - type(psb_zspmat_type), input.
! The sparse matrix structure containing the local matrix.
! Note that if p%iprcparm(mld_n_ovr_) > 0, i.e. the
! Note that if p%iprcparm(mld_sub_ovr_) > 0, i.e. the
! 'base' Additive Schwarz preconditioner has overlap greater than
! 0, and p%iprcparm(mld_sub_ren_) = 0, i.e. a reordering of the
! matrix has not been performed (see mld_fact_bld), then a contains
@ -192,16 +192,16 @@ subroutine mld_zilu_bld(a,p,upd,info,blck)
! ILU(k,t)
!
select case(p%iprcparm(mld_sub_fill_in_))
select case(p%iprcparm(mld_sub_fillin_))
case(:-1)
! Error: fill-in <= -1
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fill_in_),0,0,0/))
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fillin_),0,0,0/))
goto 9999
case(0:)
! Fill-in >= 0
call mld_ilut_fact(p%iprcparm(mld_sub_fill_in_),p%rprcparm(mld_fact_thrs_),&
call mld_ilut_fact(p%iprcparm(mld_sub_fillin_),p%rprcparm(mld_fact_thrs_),&
& a, p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
end select
if(info/=0) then
@ -215,10 +215,10 @@ subroutine mld_zilu_bld(a,p,upd,info,blck)
!
! ILU(k) and MILU(k)
!
select case(p%iprcparm(mld_sub_fill_in_))
select case(p%iprcparm(mld_sub_fillin_))
case(:-1)
! Error: fill-in <= -1
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fill_in_),0,0,0/))
call psb_errpush(30,name,i_err=(/3,p%iprcparm(mld_sub_fillin_),0,0,0/))
goto 9999
case(0)
! Fill-in 0
@ -230,13 +230,13 @@ subroutine mld_zilu_bld(a,p,upd,info,blck)
call mld_ilu0_fact(p%iprcparm(mld_sub_solve_),a,p%av(mld_l_pr_),p%av(mld_u_pr_),&
& p%d,info,blck=blck)
else
call mld_iluk_fact(p%iprcparm(mld_sub_fill_in_),p%iprcparm(mld_sub_solve_),&
call mld_iluk_fact(p%iprcparm(mld_sub_fillin_),p%iprcparm(mld_sub_solve_),&
& a,p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
endif
case(1:)
! Fill-in >= 1
! The same routine implements both ILU(k) and MILU(k)
call mld_iluk_fact(p%iprcparm(mld_sub_fill_in_),p%iprcparm(mld_sub_solve_),&
call mld_iluk_fact(p%iprcparm(mld_sub_fillin_),p%iprcparm(mld_sub_solve_),&
& a,p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
end select
if (info/=0) then

34
mlprec/mld_zilut_fact.f90
Unescape Escape View File

@ -61,7 +61,7 @@
! Arguments:
! fill_in - integer, input.
! The fill-in parameter k in ILU(k,t).
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! a - type(psb_zspmat_type), input.
! The sparse matrix structure containing the local matrix.
@ -101,7 +101,7 @@ subroutine mld_zilut_fact(fill_in,thres,a,l,u,d,info,blck)
! Arguments
integer, intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
real(psb_dpk_), intent(in) :: thres
integer, intent(out) :: info
type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u
@ -220,7 +220,7 @@ contains
! Arguments:
! fill_in - integer, input.
! The fill-in parameter k in ILU(k,t).
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! m - integer, output.
! The total number of rows of the local matrix to be factorized,
@ -273,11 +273,11 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in
integer, intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
type(psb_zspmat_type), intent(in) :: a,b
integer, intent(inout) :: m,l1,l2,info
integer, allocatable, intent(inout) :: lia1(:),lia2(:),uia1(:),uia2(:)
type(psb_zspmat_type), intent(in) :: a,b
integer, intent(inout) :: m,l1,l2,info
integer, allocatable, intent(inout) :: lia1(:),lia2(:),uia1(:),uia2(:)
complex(psb_dpk_), allocatable, intent(inout) :: laspk(:),uaspk(:)
complex(psb_dpk_), intent(inout) :: d(:)
@ -486,8 +486,8 @@ contains
type(psb_zspmat_type), intent(inout) :: trw
integer, intent(in) :: i, m,jmin,jmax,jd
integer, intent(inout) :: ktrw,nlw,nup,jmaxup,info
real(psb_dpk_), intent(inout) :: nrmi
complex(psb_dpk_), intent(inout) :: row(:)
real(psb_dpk_), intent(inout) :: nrmi
complex(psb_dpk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
integer :: k,j,irb,kin,nz
@ -624,7 +624,7 @@ contains
!
!
! Arguments
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! i - integer, input.
! The local index of the row to which the factorization is applied.
@ -679,10 +679,10 @@ contains
type(psb_int_heap), intent(inout) :: heap
integer, intent(in) :: i
integer, intent(inout) :: nidx,info
real(psb_dpk_), intent(in) :: thres,nrmi
real(psb_dpk_), intent(in) :: thres,nrmi
integer, allocatable, intent(inout) :: idxs(:)
integer, intent(inout) :: uia1(:),uia2(:)
complex(psb_dpk_), intent(inout) :: row(:), uaspk(:),d(:)
complex(psb_dpk_), intent(inout) :: row(:), uaspk(:),d(:)
! Local Variables
integer :: k,j,jj,lastk, iret
@ -796,7 +796,7 @@ contains
! Arguments:
! fill_in - integer, input.
! The fill-in parameter k in ILU(k,t).
! thres - integer, input.
! thres - real, input.
! The threshold t, i.e. the drop tolerance, in ILU(k,t).
! i - integer, input.
! The local index of the row to be copied.
@ -862,10 +862,10 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer, intent(in) :: idxs(:)
integer, intent(inout) :: l1,l2, info
integer, allocatable, intent(inout) :: uia1(:),uia2(:), lia1(:),lia2(:)
integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer, intent(in) :: idxs(:)
integer, intent(inout) :: l1,l2, info
integer, allocatable, intent(inout) :: uia1(:),uia2(:), lia1(:),lia2(:)
real(psb_dpk_), intent(in) :: thres,nrmi
complex(psb_dpk_),allocatable, intent(inout) :: uaspk(:), laspk(:)
complex(psb_dpk_), intent(inout) :: row(:), d(:)

4
mlprec/mld_zmlprec_aply.f90
Unescape Escape View File

@ -225,7 +225,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! Note that the transpose switches pre <-> post.
!
select case(baseprecv(2)%iprcparm(mld_smooth_pos_))
select case(baseprecv(2)%iprcparm(mld_smoother_pos_))
case(mld_post_smooth_)
@ -260,7 +260,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
case default
info = 4013
call psb_errpush(info,name,a_err='invalid smooth_pos',&
& i_Err=(/baseprecv(2)%iprcparm(mld_smooth_pos_),0,0,0,0/))
& i_Err=(/baseprecv(2)%iprcparm(mld_smoother_pos_),0,0,0,0/))
goto 9999
end select

4
mlprec/mld_zmlprec_bld.f90
Unescape Escape View File

@ -98,13 +98,13 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
& mld_smooth_prol_,is_legal_ml_aggr_kind)
call mld_check_def(p%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat)
call mld_check_def(p%iprcparm(mld_smooth_pos_),'smooth_pos',&
call mld_check_def(p%iprcparm(mld_smoother_pos_),'smooth_pos',&
& mld_pre_smooth_,is_legal_ml_smooth_pos)
select case(p%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%iprcparm(mld_sub_fill_in_),'Level',0,is_legal_ml_lev)
call mld_check_def(p%iprcparm(mld_sub_fillin_),'Level',0,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(p%rprcparm(mld_fact_thrs_),'Eps',dzero,is_legal_fact_thrs)
end select

42
mlprec/mld_zprecinit.f90
Unescape Escape View File

@ -118,12 +118,12 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_noprec_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_noprec_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_f_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
case ('DIAG')
@ -134,12 +134,12 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_diag_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_diag_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_f_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
case ('BJAC')
@ -150,13 +150,13 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
case ('AS')
@ -167,13 +167,13 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_halo_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
@ -191,13 +191,13 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%rprcparm(:) = dzero
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_as_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_halo_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
if (nlev_ == 1) return
@ -207,19 +207,19 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%rprcparm(:) = dzero
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
p%baseprecv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%baseprecv(ilev_)%iprcparm(mld_smooth_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_smoother_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
end do
@ -229,19 +229,19 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%rprcparm(:) = dzero
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_smoother_type_) = mld_bjac_
p%baseprecv(ilev_)%iprcparm(mld_sub_restr_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_prol_) = psb_none_
p%baseprecv(ilev_)%iprcparm(mld_sub_ren_) = 0
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
p%baseprecv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%baseprecv(ilev_)%iprcparm(mld_smooth_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_smoother_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 4
p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0

151
mlprec/mld_zprecset.f90
Unescape Escape View File

@ -123,8 +123,8 @@ 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_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smooth_sweeps_)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -133,10 +133,10 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
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_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
& mld_smoother_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
@ -159,13 +159,13 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
return
end if
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fill_in_)
case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = val
p%baseprecv(ilev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
@ -180,8 +180,8 @@ 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_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smooth_sweeps_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
@ -192,7 +192,7 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
& mld_smoother_pos_,mld_aggr_eig_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
@ -222,13 +222,13 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
return
endif
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_smooth_sweeps_) = val
case(mld_coarse_fill_in_)
case(mld_coarse_fillin_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
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
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_fillin_) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
@ -241,7 +241,7 @@ end subroutine mld_zprecseti
!
! Subroutine: mld_zprecsetc
! Version: complex
! Contains: get_stringval
! Contains: mld_stringval
!
! This routine sets the character parameters defining the preconditioner. More
! precisely, the character parameter identified by 'what' is assigned the value
@ -324,8 +324,8 @@ subroutine mld_zprecsetc(p,what,string,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_)
call get_stringval(string,val,info)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -334,13 +334,13 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
else if (ilev_ > 1) then
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_)
call get_stringval(string,val,info)
& mld_smoother_pos_,mld_aggr_eig_)
call mld_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_)
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
@ -348,7 +348,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (ilev_ /= nlev_) then
write(0,*) name,': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
@ -368,8 +368,22 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call get_stringval(string,val,info)
case(mld_smoother_type_)
call mld_stringval(string,val,info)
if ((nlev_ > 1).and.(val==mld_noprec_)) then
write(0,*) name,': Error: invalid WHAT'
info = -2
endif
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call mld_stringval(string,val,info)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
@ -379,8 +393,8 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_)
call get_stringval(string,val,info)
& mld_smoother_pos_)
call mld_stringval(string,val,info)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
@ -395,7 +409,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
info = -1
return
endif
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
@ -403,7 +417,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
info = -1
return
endif
call get_stringval(string,val,info)
call mld_stringval(string,val,info)
if (nlev_ > 1) p%baseprecv(nlev_)%iprcparm(mld_sub_solve_) = val
case default
write(0,*) name,': Error: invalid WHAT'
@ -412,91 +426,6 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
endif
contains
!
! Subroutine: get_stringval
! Note: internal subroutine of mld_dprecsetc
!
! This routine converts the string contained into string into the corresponding
! integer value.
!
! Arguments:
! string - character(len=*), input.
! The string to be converted.
! val - integer, output.
! The integer value corresponding to the string
! info - integer, output.
! Error code.
!
subroutine get_stringval(string,val,info)
! Arguments
character(len=*), intent(in) :: string
integer, intent(out) :: val, info
info = 0
select case(psb_toupper(trim(string)))
case('NONE')
val = 0
case('HALO')
val = psb_halo_
case('SUM')
val = psb_sum_
case('AVG')
val = psb_avg_
case('ILU')
val = mld_ilu_n_
case('MILU')
val = mld_milu_n_
case('ILUT')
val = mld_ilu_t_
case('UMF')
val = mld_umf_
case('SLU')
val = mld_slu_
case('SLUDIST')
val = mld_sludist_
case('ADD')
val = mld_add_ml_
case('MULT')
val = mld_mult_ml_
case('DEC')
val = mld_dec_aggr_
case('SYMDEC')
val = mld_sym_dec_aggr_
case('GLB')
val = mld_glb_aggr_
case('REPL')
val = mld_repl_mat_
case('DIST')
val = mld_distr_mat_
case('RAW')
val = mld_no_smooth_
case('SMOOTH')
val = mld_smooth_prol_
case('PRE')
val = mld_pre_smooth_
case('POST')
val = mld_post_smooth_
case('TWOSIDE','BOTH')
val = mld_twoside_smooth_
case('NOPREC')
val = mld_noprec_
case('DIAG')
val = mld_diag_
case('BJAC')
val = mld_bjac_
case('AS')
val = mld_as_
case default
val = -1
info = -1
end select
if (info /= 0) then
write(0,*) name,': Error: unknown request: "',trim(string),'"'
end if
end subroutine get_stringval
end subroutine mld_zprecsetc

8
test/fileread/cf_sample.f90
Unescape Escape View File

@ -227,21 +227,21 @@ program cf_sample
nlv = 1
end if
call mld_precinit(prec,prec_choice%prec,info,nlev=nlv)
call mld_precset(prec,mld_n_ovr_,prec_choice%novr,info)
call mld_precset(prec,mld_sub_ovr_,prec_choice%novr,info)
call mld_precset(prec,mld_sub_restr_,prec_choice%restr,info)
call mld_precset(prec,mld_sub_prol_,prec_choice%prol,info)
call mld_precset(prec,mld_sub_solve_,prec_choice%solve,info)
call mld_precset(prec,mld_sub_fill_in_,prec_choice%fill1,info)
call mld_precset(prec,mld_sub_fillin_,prec_choice%fill1,info)
call mld_precset(prec,mld_fact_thrs_,prec_choice%thr1,info)
if (psb_toupper(prec_choice%prec) =='ML') then
call mld_precset(prec,mld_aggr_kind_,prec_choice%aggrkind,info)
call mld_precset(prec,mld_aggr_alg_,prec_choice%aggr_alg,info)
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_smooth_pos_,prec_choice%smthpos,info)
call mld_precset(prec,mld_smoother_pos_,prec_choice%smthpos,info)
call mld_precset(prec,mld_coarse_mat_,prec_choice%cmat,info)
call mld_precset(prec,mld_coarse_solve_,prec_choice%csolve,info)
call mld_precset(prec,mld_sub_fill_in_,prec_choice%cfill,info,ilev=nlv)
call mld_precset(prec,mld_sub_fillin_,prec_choice%cfill,info,ilev=nlv)
call mld_precset(prec,mld_fact_thrs_,prec_choice%cthres,info,ilev=nlv)
call mld_precset(prec,mld_aggr_thresh_,prec_choice%athres,info)
call mld_precset(prec,mld_smooth_sweeps_,prec_choice%cjswp,info,ilev=nlv)

8
test/fileread/df_bench.f90
Unescape Escape View File

@ -235,20 +235,20 @@ program df_bench
call mld_precset(pre,mld_ml_type_, precs(pp)%mltype, info,ilev=nlev)
call mld_precset(pre,mld_aggr_alg_, precs(pp)%aggr, info,ilev=nlev)
call mld_precset(pre,mld_coarse_mat_, precs(pp)%cmat, info,ilev=nlev)
call mld_precset(pre,mld_smooth_pos_, precs(pp)%smthpos, info,ilev=nlev)
call mld_precset(pre,mld_smoother_pos_, precs(pp)%smthpos, info,ilev=nlev)
call mld_precset(pre,mld_sub_solve_, precs(pp)%ftype2, info,ilev=nlev)
call mld_precset(pre,mld_sub_fill_in_, precs(pp)%fill2, info,ilev=nlev)
call mld_precset(pre,mld_sub_fillin_, precs(pp)%fill2, info,ilev=nlev)
call mld_precset(pre,mld_fact_thrs_, precs(pp)%thr2, info,ilev=nlev)
call mld_precset(pre,mld_smooth_sweeps_, precs(pp)%jswp, info,ilev=nlev)
call mld_precset(pre,mld_aggr_kind_, precs(pp)%smthkind, info,ilev=nlev)
else
call mld_precinit(pre,precs(pp)%lv1,info)
end if
call mld_precset(pre,mld_n_ovr_, precs(pp)%novr, info,ilev=1)
call mld_precset(pre,mld_sub_ovr_, precs(pp)%novr, info,ilev=1)
call mld_precset(pre,mld_sub_restr_, precs(pp)%restr, info,ilev=1)
call mld_precset(pre,mld_sub_prol_, precs(pp)%prol, info,ilev=1)
call mld_precset(pre,mld_sub_solve_, precs(pp)%ftype1, info,ilev=1)
call mld_precset(pre,mld_sub_fill_in_, precs(pp)%fill1, info,ilev=1)
call mld_precset(pre,mld_sub_fillin_, precs(pp)%fill1, info,ilev=1)
call mld_precset(pre,mld_fact_thrs_, precs(pp)%thr1, info,ilev=1)

8
test/fileread/df_sample.f90
Unescape Escape View File

@ -227,21 +227,21 @@ program df_sample
nlv = 1
end if
call mld_precinit(prec,prec_choice%prec,info,nlev=nlv)
call mld_precset(prec,mld_n_ovr_,prec_choice%novr,info)
call mld_precset(prec,mld_sub_ovr_,prec_choice%novr,info)
call mld_precset(prec,mld_sub_restr_,prec_choice%restr,info)
call mld_precset(prec,mld_sub_prol_,prec_choice%prol,info)
call mld_precset(prec,mld_sub_solve_,prec_choice%solve,info)
call mld_precset(prec,mld_sub_fill_in_,prec_choice%fill1,info)
call mld_precset(prec,mld_sub_fillin_,prec_choice%fill1,info)
call mld_precset(prec,mld_fact_thrs_,prec_choice%thr1,info)
if (psb_toupper(prec_choice%prec) =='ML') then
call mld_precset(prec,mld_aggr_kind_,prec_choice%aggrkind,info)
call mld_precset(prec,mld_aggr_alg_,prec_choice%aggr_alg,info)
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_smooth_pos_,prec_choice%smthpos,info)
call mld_precset(prec,mld_smoother_pos_,prec_choice%smthpos,info)
call mld_precset(prec,mld_coarse_mat_,prec_choice%cmat,info)
call mld_precset(prec,mld_coarse_solve_,prec_choice%csolve,info)
call mld_precset(prec,mld_sub_fill_in_,prec_choice%cfill,info,ilev=nlv)
call mld_precset(prec,mld_sub_fillin_,prec_choice%cfill,info,ilev=nlv)
call mld_precset(prec,mld_fact_thrs_,prec_choice%cthres,info,ilev=nlv)
call mld_precset(prec,mld_aggr_thresh_,prec_choice%athres,info)
call mld_precset(prec,mld_smooth_sweeps_,prec_choice%cjswp,info,ilev=nlv)

8
test/fileread/sf_sample.f90
Unescape Escape View File

@ -227,21 +227,21 @@ program sf_sample
nlv = 1
end if
call mld_precinit(prec,prec_choice%prec,info,nlev=nlv)
call mld_precset(prec,mld_n_ovr_,prec_choice%novr,info)
call mld_precset(prec,mld_sub_ovr_,prec_choice%novr,info)
call mld_precset(prec,mld_sub_restr_,prec_choice%restr,info)
call mld_precset(prec,mld_sub_prol_,prec_choice%prol,info)
call mld_precset(prec,mld_sub_solve_,prec_choice%solve,info)
call mld_precset(prec,mld_sub_fill_in_,prec_choice%fill1,info)
call mld_precset(prec,mld_sub_fillin_,prec_choice%fill1,info)
call mld_precset(prec,mld_fact_thrs_,prec_choice%thr1,info)
if (psb_toupper(prec_choice%prec) =='ML') then
call mld_precset(prec,mld_aggr_kind_,prec_choice%aggrkind,info)
call mld_precset(prec,mld_aggr_alg_,prec_choice%aggr_alg,info)
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_smooth_pos_,prec_choice%smthpos,info)
call mld_precset(prec,mld_smoother_pos_,prec_choice%smthpos,info)
call mld_precset(prec,mld_coarse_mat_,prec_choice%cmat,info)
call mld_precset(prec,mld_coarse_solve_,prec_choice%csolve,info)
call mld_precset(prec,mld_sub_fill_in_,prec_choice%cfill,info,ilev=nlv)
call mld_precset(prec,mld_sub_fillin_,prec_choice%cfill,info,ilev=nlv)
call mld_precset(prec,mld_fact_thrs_,prec_choice%cthres,info,ilev=nlv)
call mld_precset(prec,mld_aggr_thresh_,prec_choice%athres,info)
call mld_precset(prec,mld_smooth_sweeps_,prec_choice%cjswp,info,ilev=nlv)

8
test/fileread/zf_bench.f90
Unescape Escape View File

@ -220,20 +220,20 @@ program zf_bench
call mld_precset(pre,mld_ml_type_, precs(pp)%mltype, info,ilev=nlev)
call mld_precset(pre,mld_aggr_alg_, precs(pp)%aggr, info,ilev=nlev)
call mld_precset(pre,mld_coarse_mat_, precs(pp)%cmat, info,ilev=nlev)
call mld_precset(pre,mld_smooth_pos_, precs(pp)%smthpos, info,ilev=nlev)
call mld_precset(pre,mld_smoother_pos_, precs(pp)%smthpos, info,ilev=nlev)
call mld_precset(pre,mld_sub_solve_, precs(pp)%ftype2, info,ilev=nlev)
call mld_precset(pre,mld_sub_fill_in_, precs(pp)%fill2, info,ilev=nlev)
call mld_precset(pre,mld_sub_fillin_, precs(pp)%fill2, info,ilev=nlev)
call mld_precset(pre,mld_fact_thrs_, precs(pp)%thr2, info,ilev=nlev)
call mld_precset(pre,mld_smooth_sweeps_, precs(pp)%jswp, info,ilev=nlev)
call mld_precset(pre,mld_aggr_kind_, precs(pp)%smthkind, info,ilev=nlev)
else
call mld_precinit(pre,precs(pp)%lv1,info)
end if
call mld_precset(pre,mld_n_ovr_, precs(pp)%novr, info,ilev=1)
call mld_precset(pre,mld_sub_ovr_, precs(pp)%novr, info,ilev=1)
call mld_precset(pre,mld_sub_restr_, precs(pp)%restr, info,ilev=1)
call mld_precset(pre,mld_sub_prol_, precs(pp)%prol, info,ilev=1)
call mld_precset(pre,mld_sub_solve_, precs(pp)%ftype1, info,ilev=1)
call mld_precset(pre,mld_sub_fill_in_, precs(pp)%fill1, info,ilev=1)
call mld_precset(pre,mld_sub_fillin_, precs(pp)%fill1, info,ilev=1)
call mld_precset(pre,mld_fact_thrs_, precs(pp)%thr1, info,ilev=1)

8
test/fileread/zf_sample.f90
Unescape Escape View File

@ -227,21 +227,21 @@ program zf_sample
nlv = 1
end if
call mld_precinit(prec,prec_choice%prec,info,nlev=nlv)
call mld_precset(prec,mld_n_ovr_,prec_choice%novr,info)
call mld_precset(prec,mld_sub_ovr_,prec_choice%novr,info)
call mld_precset(prec,mld_sub_restr_,prec_choice%restr,info)
call mld_precset(prec,mld_sub_prol_,prec_choice%prol,info)
call mld_precset(prec,mld_sub_solve_,prec_choice%solve,info)
call mld_precset(prec,mld_sub_fill_in_,prec_choice%fill1,info)
call mld_precset(prec,mld_sub_fillin_,prec_choice%fill1,info)
call mld_precset(prec,mld_fact_thrs_,prec_choice%thr1,info)
if (psb_toupper(prec_choice%prec) =='ML') then
call mld_precset(prec,mld_aggr_kind_,prec_choice%aggrkind,info)
call mld_precset(prec,mld_aggr_alg_,prec_choice%aggr_alg,info)
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_ml_type_,prec_choice%mltype,info)
call mld_precset(prec,mld_smooth_pos_,prec_choice%smthpos,info)
call mld_precset(prec,mld_smoother_pos_,prec_choice%smthpos,info)
call mld_precset(prec,mld_coarse_mat_,prec_choice%cmat,info)
call mld_precset(prec,mld_coarse_solve_,prec_choice%csolve,info)
call mld_precset(prec,mld_sub_fill_in_,prec_choice%cfill,info,ilev=nlv)
call mld_precset(prec,mld_sub_fillin_,prec_choice%cfill,info,ilev=nlv)
call mld_precset(prec,mld_fact_thrs_,prec_choice%cthres,info,ilev=nlv)
call mld_precset(prec,mld_aggr_thresh_,prec_choice%athres,info)
call mld_precset(prec,mld_smooth_sweeps_,prec_choice%cjswp,info,ilev=nlv)

8
test/pargen/ppde.f90
Unescape Escape View File

@ -227,21 +227,21 @@ program ppde
nlv = 1
end if
call mld_precinit(prec,prectype%prec,info,nlev=nlv)
call mld_precset(prec,mld_n_ovr_,prectype%novr,info)
call mld_precset(prec,mld_sub_ovr_,prectype%novr,info)
call mld_precset(prec,mld_sub_restr_,prectype%restr,info)
call mld_precset(prec,mld_sub_prol_,prectype%prol,info)
call mld_precset(prec,mld_sub_solve_,prectype%solve,info)
call mld_precset(prec,mld_sub_fill_in_,prectype%fill1,info)
call mld_precset(prec,mld_sub_fillin_,prectype%fill1,info)
call mld_precset(prec,mld_fact_thrs_,prectype%thr1,info)
if (psb_toupper(prectype%prec) =='ML') then
call mld_precset(prec,mld_aggr_kind_,prectype%aggrkind,info)
call mld_precset(prec,mld_aggr_alg_,prectype%aggr_alg,info)
call mld_precset(prec,mld_ml_type_,prectype%mltype,info)
call mld_precset(prec,mld_ml_type_,prectype%mltype,info)
call mld_precset(prec,mld_smooth_pos_,prectype%smthpos,info)
call mld_precset(prec,mld_smoother_pos_,prectype%smthpos,info)
call mld_precset(prec,mld_coarse_mat_,prectype%cmat,info)
call mld_precset(prec,mld_coarse_solve_,prectype%csolve,info)
call mld_precset(prec,mld_sub_fill_in_,prectype%cfill,info,ilev=nlv)
call mld_precset(prec,mld_sub_fillin_,prectype%cfill,info,ilev=nlv)
call mld_precset(prec,mld_fact_thrs_,prectype%cthres,info,ilev=nlv)
call mld_precset(prec,mld_smooth_sweeps_,prectype%cjswp,info,ilev=nlv)
call mld_precset(prec,mld_smooth_sweeps_,prectype%cjswp,info,ilev=nlv)

8
test/pargen/spde.f90
Unescape Escape View File

@ -240,21 +240,21 @@ program spde
nlv = 1
end if
call mld_precinit(prec,prectype%prec,info,nlev=nlv)
call mld_precset(prec,mld_n_ovr_,prectype%novr,info)
call mld_precset(prec,mld_sub_ovr_,prectype%novr,info)
call mld_precset(prec,mld_sub_restr_,prectype%restr,info)
call mld_precset(prec,mld_sub_prol_,prectype%prol,info)
call mld_precset(prec,mld_sub_solve_,prectype%solve,info)
call mld_precset(prec,mld_sub_fill_in_,prectype%fill1,info)
call mld_precset(prec,mld_sub_fillin_,prectype%fill1,info)
call mld_precset(prec,mld_fact_thrs_,prectype%thr1,info)
if (psb_toupper(prectype%prec) =='ML') then
call mld_precset(prec,mld_aggr_kind_,prectype%aggrkind,info)
call mld_precset(prec,mld_aggr_alg_,prectype%aggr_alg,info)
call mld_precset(prec,mld_ml_type_,prectype%mltype,info)
call mld_precset(prec,mld_ml_type_,prectype%mltype,info)
call mld_precset(prec,mld_smooth_pos_,prectype%smthpos,info)
call mld_precset(prec,mld_smoother_pos_,prectype%smthpos,info)
call mld_precset(prec,mld_coarse_mat_,prectype%cmat,info)
call mld_precset(prec,mld_coarse_solve_,prectype%csolve,info)
call mld_precset(prec,mld_sub_fill_in_,prectype%cfill,info,ilev=nlv)
call mld_precset(prec,mld_sub_fillin_,prectype%cfill,info,ilev=nlv)
call mld_precset(prec,mld_fact_thrs_,prectype%cthres,info,ilev=nlv)
call mld_precset(prec,mld_smooth_sweeps_,prectype%cjswp,info,ilev=nlv)
call mld_precset(prec,mld_smooth_sweeps_,prectype%cjswp,info,ilev=nlv)

Write Preview
Loading…
Cancel
Save