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

Merge branch 'mld2p4-bcmatch' into development

Browse Source
stopcriterion
Salvatore Filippone 6 years ago
parent a625f229bc 3d6d453fe4
commit 37f068539a
209 changed files with 2467 additions and 10274 deletions
Show Stats Download Patch File Download Diff File

4
docs/html/node13.html
Unescape Escape View File

@ -262,8 +262,8 @@ end
\begin{tabbing}
\quad \=\quad \=\quad...
...[1mm]
\>endif \\ [1mm]
\>return $u^k$\ \\ [1mm]
\>endif [1mm]
\>return $u^k$ [1mm]
end
\end{tabbing}\end{minipage}}">

47
docs/html/node20.html
Unescape Escape View File

@ -54,7 +54,7 @@ Method set
</H2><BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
<P>
<BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
<DIV ALIGN="CENTER"><BIG CLASS="LARGE"><BIG CLASS="LARGE"><BIG CLASS="LARGE"><code>call p%set(what,val,info [,ilev, ilmax, pos])</code>
<DIV ALIGN="CENTER"><BIG CLASS="LARGE"><BIG CLASS="LARGE"><BIG CLASS="LARGE"><code>call p%set(what,val,info [,ilev, ilmax, pos, idx])</code>
</BIG></BIG></BIG></DIV><BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
<P>
<BIG CLASS="LARGE"><BIG CLASS="LARGE"><BIG CLASS="LARGE">
@ -139,7 +139,16 @@ contained in <code>val</code>.
or to the post-smoother (<code>'POST'</code>). If <code>pos</code> is not present,
the other arguments are applied to both smoothers.
If the preconditioner is one-level or the parameter identified by <code>what</code>
does not concern the smoothers, <code>pos</code> is ignored.
does not concern the smoothers, <code>pos</code> is ignored.</BIG></BIG></BIG></TD>
</TR>
<TR><TD ALIGN="LEFT" VALIGN="TOP" WIDTH=34><BIG CLASS="LARGE"><BIG CLASS="LARGE"><BIG CLASS="LARGE">
<code>idx</code> </BIG></BIG></BIG></TD>
<TD ALIGN="LEFT" VALIGN="TOP" WIDTH=340><BIG CLASS="LARGE"><BIG CLASS="LARGE"><BIG CLASS="LARGE"> <code>integer, optional, intent(in)</code>.</BIG></BIG></BIG></TD>
</TR>
<TR><TD ALIGN="LEFT" VALIGN="TOP" WIDTH=34><BIG CLASS="LARGE"><BIG CLASS="LARGE"><BIG CLASS="LARGE">
</BIG></BIG></BIG></TD>
<TD ALIGN="LEFT" VALIGN="TOP" WIDTH=340><BIG CLASS="LARGE"><BIG CLASS="LARGE"><BIG CLASS="LARGE"> An auxiliary input argument that can be passed to the
underlying objects.
</BIG></BIG></BIG></TD>
</TR>
</TABLE><BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
@ -153,7 +162,8 @@ as follows:
</BIG></BIG></BIG></DIV><BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
<P>
<BIG CLASS="LARGE"><BIG CLASS="LARGE"><BIG CLASS="LARGE">
However, in this case the optional arguments <code>ilev</code>, <code>ilmax</code>, and <code>pos</code>
However, in this case the optional arguments <code>ilev</code>,
<code>ilmax</code>, <code>pos</code> and <code>idx</code>
cannot be used.
<BR></BIG></BIG></BIG>
<P>
@ -245,9 +255,16 @@ therefore, if SuperLu_Dist has been previously set, the coarsest-level
solver is changed to the default sequential solver.
</BIG></BIG></BIG>
<P>
<BIG CLASS="LARGE"><BIG CLASS="LARGE"><BIG CLASS="LARGE"><SPAN CLASS="textbf">Remark 4.</SPAN> The argument <code>idx</code> can be used to allow finer
control for those solvers; for instance, by specifying the keyword
<code>MUMPS_IPAR_ENTRY</code> and an appropriate value for <code>idx</code>, it is
possible to set any entry in the MUMPS integer control array.
See also Sec.&nbsp;<A HREF="node33.html#sec:adding">7</A>.
</BIG></BIG></BIG>
<P>
<BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
<BR><P></P>
<DIV ALIGN="CENTER"><A NAME="1390"></A>
<DIV ALIGN="CENTER"><A NAME="1392"></A>
<TABLE>
<CAPTION><STRONG>Table 2:</STRONG>
Parameters defining the multilevel cycle and the number of cycles to
@ -300,7 +317,7 @@ number <SPAN CLASS="MATH"><IMG
<P>
<BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
<BR><P></P>
<DIV ALIGN="CENTER"><A NAME="1396"></A>
<DIV ALIGN="CENTER"><A NAME="1398"></A>
<TABLE>
<CAPTION><STRONG>Table 3:</STRONG>
Parameters defining the aggregation algorithm.
@ -419,7 +436,7 @@ of levels. </SPAN></TD>
<P>
<BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
<BR><P></P>
<DIV ALIGN="CENTER"><A NAME="1400"></A>
<DIV ALIGN="CENTER"><A NAME="1402"></A>
<TABLE>
<CAPTION><STRONG>Table 4:</STRONG>
Parameters defining the aggregation algorithm (continued).
@ -486,7 +503,7 @@ the parameter <TT>ilev</TT>.</SPAN></TD>
<P>
<BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
<BR><P></P>
<DIV ALIGN="CENTER"><A NAME="1405"></A>
<DIV ALIGN="CENTER"><A NAME="1407"></A>
<TABLE>
<CAPTION><STRONG>Table 5:</STRONG>
Parameters defining the coarse-space correction at the coarsest
@ -593,7 +610,7 @@ Note that <TT>UMF</TT> and <TT>SLU</TT> require the coarsest
<P>
<BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
<BR><P></P>
<DIV ALIGN="CENTER"><A NAME="1407"></A>
<DIV ALIGN="CENTER"><A NAME="1409"></A>
<TABLE>
<CAPTION><STRONG>Table 6:</STRONG>
Parameters defining the coarse-space correction at the coarsest
@ -659,7 +676,7 @@ number <SPAN CLASS="MATH"><IMG
<P>
<BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
<BR><P></P>
<DIV ALIGN="CENTER"><A NAME="1409"></A>
<DIV ALIGN="CENTER"><A NAME="1411"></A>
<TABLE>
<CAPTION><STRONG>Table 7:</STRONG>
Parameters defining the smoother or the details of the one-level preconditioner.
@ -786,7 +803,7 @@ Parameters defining the smoother or the details of the one-level preconditioner.
<P>
<BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
<BR><P></P>
<DIV ALIGN="CENTER"><A NAME="1411"></A>
<DIV ALIGN="CENTER"><A NAME="1413"></A>
<TABLE>
<CAPTION><STRONG>Table 8:</STRONG>
Parameters defining the smoother or the details of the one-level preconditioner
@ -873,6 +890,16 @@ Parameters defining the smoother or the details of the one-level preconditioner
SRC="img83.png"
ALT="$p,t$"></SPAN>) factorization. </SMALL></TD>
</TR>
<TR><TD ALIGN="LEFT" VALIGN="TOP" WIDTH=85><SMALL CLASS="SMALL"> <code>'MUMPS_IPAR_ENTRY'</code> </SMALL></TD>
<TD ALIGN="LEFT"><SMALL CLASS="SMALL"> <code>integer</code>
</SMALL></TD>
<TD ALIGN="LEFT" VALIGN="TOP" WIDTH=71><SMALL CLASS="SMALL"> Any integer number
</SMALL></TD>
<TD ALIGN="LEFT" VALIGN="TOP" WIDTH=62><SMALL CLASS="SMALL"> 0
</SMALL></TD>
<TD ALIGN="LEFT" VALIGN="TOP" WIDTH=201><SMALL CLASS="SMALL"> Set an entry in the MUMPS control array, as
chosen via the <code>idx</code> optional argument. </SMALL></TD>
</TR>
<TR><TD ALIGN="LEFT" VALIGN="TOP" WIDTH=85><SMALL CLASS="SMALL"> </SMALL></TD>
<TD></TD>
<TD></TD>

2
docs/html/node24.html
Unescape Escape View File

@ -64,7 +64,7 @@ This method computes <!-- MATH
<SPAN CLASS="MATH"><IMG
WIDTH="113" HEIGHT="39" ALIGN="MIDDLE" BORDER="0"
SRC="img86.png"
ALT="$y = op(B^{-1})\, x$"></SPAN>, where <SPAN CLASS="MATH"><IMG
ALT="$y = op(B^{-1}) x$"></SPAN>, where <SPAN CLASS="MATH"><IMG
WIDTH="19" HEIGHT="15" ALIGN="BOTTOM" BORDER="0"
SRC="img24.png"
ALT="$B$"></SPAN> is a previously built

5
docs/html/node33.html
Unescape Escape View File

@ -96,7 +96,10 @@ been modified to account for this new development.
<code>set</code> routine; if the library code does not recognize a keyword,
it passes it down the composition hierarchy (levels containing
smoothers containing in turn solvers), so that it can be eventually caught by
the new solver.
the new solver. By the same token, any keyword/value pair that does not pertain to
a given smoother should be passed down to the contained solver, and
any keyword/value pair that does not pertain to a given solver is by
default ignored.
</BIG></BIG></BIG>
<P>
<BIG CLASS="LARGE"><BIG CLASS="LARGE"><BIG CLASS="LARGE">An example is provided in the source code distribution under the

2
docs/html/node37.html
Unescape Escape View File

@ -60,7 +60,7 @@ Mathematics Department, Macquarie University, Sydney.
The command line arguments were: <BR>
<STRONG>latex2html</STRONG> <TT>-local_icons -noaddress -dir ../../html userhtml.tex</TT>
<P>
The translation was initiated on 2018-05-14<BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
The translation was initiated on 2018-10-05<BIG CLASS="LARGE"><BIG CLASS="LARGE"></BIG></BIG>
<BR><HR>
</BODY>

1410
docs/mld2p4-2.2-guide.pdf
View File

File diff suppressed because it is too large Load Diff

5
docs/src/newobjects.tex
Unescape Escape View File

@ -38,7 +38,10 @@ It is possible to define new values for the keyword \verb|WHAT| in the
\verb|set| routine; if the library code does not recognize a keyword,
it passes it down the composition hierarchy (levels containing
smoothers containing in turn solvers), so that it can be eventually caught by
the new solver.
the new solver. By the same token, any keyword/value pair that does not pertain to
a given smoother should be passed down to the contained solver, and
any keyword/value pair that does not pertain to a given solver is by
default ignored.
An example is provided in the source code distribution under the
folder \verb|tests/newslv|. In this example we are implementing a new

20
docs/src/userinterface.tex
Unescape Escape View File

@ -85,7 +85,7 @@ as follows:
\subsection{Method set\label{sec:precset}}
\begin{center}
\verb|call p%set(what,val,info [,ilev, ilmax, pos])|
\verb|call p%set(what,val,info [,ilev, ilmax, pos, idx])|
\end{center}
\noindent
@ -136,7 +136,10 @@ contained in \verb|val|.
or to the post-smoother (\verb|'POST'|). If \verb|pos| is not present,
the other arguments are applied to both smoothers.
If the preconditioner is one-level or the parameter identified by \verb|what|
does not concern the smoothers, \verb|pos| is ignored.
does not concern the smoothers, \verb|pos| is ignored.\\
\verb|idx| & \verb|integer, optional, intent(in)|.\\
& An auxiliary input argument that can be passed to the
underlying objects.
\end{tabular}
\vskip1.5\baselineskip
@ -148,7 +151,8 @@ as follows:
\end{center}
\noindent
However, in this case the optional arguments \verb|ilev|, \verb|ilmax|, and \verb|pos|
However, in this case the optional arguments \verb|ilev|,
\verb|ilmax|, \verb|pos| and \verb|idx|
cannot be used. \\
A variety of preconditioners can be obtained
@ -226,6 +230,11 @@ Likewise, the replicated layout can be used with any solver but SuperLu\_Dist;
therefore, if SuperLu\_Dist has been previously set, the coarsest-level
solver is changed to the default sequential solver.
\textbf{Remark 4.} The argument \verb|idx| can be used to allow finer
control for those solvers; for instance, by specifying the keyword
\verb|MUMPS_IPAR_ENTRY| and an appropriate value for \verb|idx|, it is
possible to set any entry in the MUMPS integer control array.
See also Sec.~\ref{sec:adding}.
%The \verb|what,val| pairs described here are those of the predefined
%moother/solver objects; newly developed solvers may define new pairs
%according to their needs.
@ -609,6 +618,11 @@ level (continued).\label{tab:p_coarse_1}}
& Any real number~$\ge 0$
& 0
& Drop tolerance $t$ in the ILU($p,t$) factorization. \\ %\hline
\verb|'MUMPS_IPAR_ENTRY'| & \verb|integer|
& Any integer number
& 0
& Set an entry in the MUMPS control array, as
chosen via the \verb|idx| optional argument. \\ %\hline
%\verb|mld_sub_ren_| \par \verb|SUB_REN| & \verb|character(len=*)|
% & \texttt{'RENUM\_NONE'} \texttt{'RENUM\_GLOBAL'} %, \texttt{'RENUM_GPS'}
% & \texttt{'RENUM\_NONE'}

2
examples/fileread/mld_cexample_1lev.f90
Unescape Escape View File

@ -193,7 +193,7 @@ program mld_cexample_1lev
! set RAS
call P%init('AS',info)
call P%init(ictxt,'AS',info)
! set number of overlaps

2
examples/fileread/mld_cexample_ml.f90
Unescape Escape View File

@ -212,7 +212,7 @@ program mld_cexample_ml
! GS sweep as pre/post-smoother and UMFPACK as coarsest-level
! solver
call P%init('ML',info)
call P%init(ictxt,'ML',info)
kmethod = 'CG'
case(2)

2
examples/fileread/mld_dexample_1lev.f90
Unescape Escape View File

@ -193,7 +193,7 @@ program mld_dexample_1lev
! set RAS
call P%init('AS',info)
call P%init(ictxt,'AS',info)
! set number of overlaps

2
examples/fileread/mld_dexample_ml.f90
Unescape Escape View File

@ -212,7 +212,7 @@ program mld_dexample_ml
! GS sweep as pre/post-smoother and UMFPACK as coarsest-level
! solver
call P%init('ML',info)
call P%init(ictxt,'ML',info)
kmethod = 'CG'
case(2)

2
examples/fileread/mld_sexample_1lev.f90
Unescape Escape View File

@ -193,7 +193,7 @@ program mld_sexample_1lev
! set RAS
call P%init('AS',info)
call P%init(ictxt,'AS',info)
! set number of overlaps

2
examples/fileread/mld_sexample_ml.f90
Unescape Escape View File

@ -212,7 +212,7 @@ program mld_sexample_ml
! GS sweep as pre/post-smoother and UMFPACK as coarsest-level
! solver
call P%init('ML',info)
call P%init(ictxt,'ML',info)
kmethod = 'CG'
case(2)

2
examples/fileread/mld_zexample_1lev.f90
Unescape Escape View File

@ -193,7 +193,7 @@ program mld_zexample_1lev
! set RAS
call P%init('AS',info)
call P%init(ictxt,'AS',info)
! set number of overlaps

2
examples/fileread/mld_zexample_ml.f90
Unescape Escape View File

@ -212,7 +212,7 @@ program mld_zexample_ml
! GS sweep as pre/post-smoother and UMFPACK as coarsest-level
! solver
call P%init('ML',info)
call P%init(ictxt,'ML',info)
kmethod = 'CG'
case(2)

2
examples/pdegen/mld_dexample_1lev.f90
Unescape Escape View File

@ -140,7 +140,7 @@ program mld_dexample_1lev
! set RAS
call P%init('AS',info)
call P%init(ictxt,'AS',info)
! set number of overlaps

6
examples/pdegen/mld_dexample_ml.f90
Unescape Escape View File

@ -168,7 +168,7 @@ program mld_dexample_ml
! GS sweep as pre/post-smoother and UMFPACK as coarsest-level
! solver
call P%init('ML',info)
call P%init(ictxt,'ML',info)
kmethod = 'CG'
case(2)
@ -177,7 +177,7 @@ program mld_dexample_ml
! ILU(0) on the blocks) as pre- and post-smoother, and 8 block-Jacobi
! sweeps (with ILU(0) on the blocks) as coarsest-level solver
call P%init('ML',info)
call P%init(ictxt,'ML',info)
call P%set('SMOOTHER_TYPE','BJAC',info)
call P%set('COARSE_SOLVE','BJAC',info)
call P%set('COARSE_SWEEPS',8,info)
@ -189,7 +189,7 @@ program mld_dexample_ml
! GS sweeps as pre/post-smoother, a distributed coarsest
! matrix, and MUMPS as coarsest-level solver
call P%init('ML',info)
call P%init(ictxt,'ML',info)
call P%set('ML_CYCLE','WCYCLE',info)
call P%set('SMOOTHER_SWEEPS',2,info)
call P%set('COARSE_SOLVE','MUMPS',info)

2
examples/pdegen/mld_sexample_1lev.f90
Unescape Escape View File

@ -140,7 +140,7 @@ program mld_sexample_1lev
! set RAS
call P%init('AS',info)
call P%init(ictxt,'AS',info)
! set number of overlaps

6
examples/pdegen/mld_sexample_ml.f90
Unescape Escape View File

@ -168,7 +168,7 @@ program mld_sexample_ml
! GS sweep as pre/post-smoother and UMFPACK as coarsest-level
! solver
call P%init('ML',info)
call P%init(ictxt,'ML',info)
kmethod = 'CG'
case(2)
@ -177,7 +177,7 @@ program mld_sexample_ml
! ILU(0) on the blocks) as pre- and post-smoother, and 8 block-Jacobi
! sweeps (with ILU(0) on the blocks) as coarsest-level solver
call P%init('ML',info)
call P%init(ictxt,'ML',info)
call P%set('SMOOTHER_TYPE','BJAC',info)
call P%set('COARSE_SOLVE','BJAC',info)
call P%set('COARSE_SWEEPS',8,info)
@ -189,7 +189,7 @@ program mld_sexample_ml
! GS sweeps as pre/post-smoother, a distributed coarsest
! matrix, and MUMPS as coarsest-level solver
call P%init('ML',info)
call P%init(ictxt,'ML',info)
call P%set('ML_CYCLE','WCYCLE',info)
call P%set('SMOOTHER_SWEEPS',2,info)
call P%set('COARSE_SOLVE','MUMPS',info)

13
mlprec/impl/level/Makefile
Unescape Escape View File

@ -19,9 +19,6 @@ mld_c_base_onelev_dump.o \
mld_c_base_onelev_free.o \
mld_c_base_onelev_mat_asb.o \
mld_c_base_onelev_setag.o \
mld_c_base_onelev_setc.o \
mld_c_base_onelev_seti.o \
mld_c_base_onelev_setr.o \
mld_c_base_onelev_setsm.o \
mld_c_base_onelev_setsv.o \
mld_d_base_onelev_build.o \
@ -35,9 +32,6 @@ mld_d_base_onelev_dump.o \
mld_d_base_onelev_free.o \
mld_d_base_onelev_mat_asb.o \
mld_d_base_onelev_setag.o \
mld_d_base_onelev_setc.o \
mld_d_base_onelev_seti.o \
mld_d_base_onelev_setr.o \
mld_d_base_onelev_setsm.o \
mld_d_base_onelev_setsv.o \
mld_s_base_onelev_build.o \
@ -51,9 +45,6 @@ mld_s_base_onelev_dump.o \
mld_s_base_onelev_free.o \
mld_s_base_onelev_mat_asb.o \
mld_s_base_onelev_setag.o \
mld_s_base_onelev_setc.o \
mld_s_base_onelev_seti.o \
mld_s_base_onelev_setr.o \
mld_s_base_onelev_setsm.o \
mld_s_base_onelev_setsv.o \
mld_z_base_onelev_build.o \
@ -67,12 +58,10 @@ mld_z_base_onelev_dump.o \
mld_z_base_onelev_free.o \
mld_z_base_onelev_mat_asb.o \
mld_z_base_onelev_setag.o \
mld_z_base_onelev_setc.o \
mld_z_base_onelev_seti.o \
mld_z_base_onelev_setr.o \
mld_z_base_onelev_setsm.o \
mld_z_base_onelev_setsv.o
LIBNAME=libmld_prec.a
lib: $(OBJS)

8
mlprec/impl/level/mld_c_base_onelev_csetc.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos)
subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos,idx)
use psb_base_mod
use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_csetc
@ -48,6 +48,7 @@ subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos)
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='c_base_onelev_csetc'
@ -77,15 +78,16 @@ subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos)
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if
if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx)
end if

8
mlprec/impl/level/mld_c_base_onelev_cseti.F90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos,idx)
use psb_base_mod
use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_cseti
@ -63,6 +63,7 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='c_base_onelev_cseti'
@ -232,14 +233,15 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
case default
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if
if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx)
end select
if (info /= psb_success_) goto 9999

9
mlprec/impl/level/mld_c_base_onelev_csetr.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos)
subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos,idx)
use psb_base_mod
use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_csetr
@ -48,6 +48,7 @@ subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos)
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='c_base_onelev_csetr'
@ -82,14 +83,16 @@ subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos)
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if
if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx)
end select
if (info /= psb_success_) goto 9999

99
mlprec/impl/level/mld_c_base_onelev_setc.f90
Unescape Escape View File

@ -1,99 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_onelev_setc(lv,what,val,info,pos)
use psb_base_mod
use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_setc
Implicit None
! Arguments
class(mld_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='c_base_onelev_setc'
integer(psb_ipk_) :: ival
call psb_erractionsave(err_act)
info = psb_success_
ival = lv%stringval(val)
if (ival >= 0) then
call lv%set(what,ival,info,pos=pos)
else
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_smooth_post_
case default
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
end if
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_c_base_onelev_setc

253
mlprec/impl/level/mld_c_base_onelev_seti.F90
Unescape Escape View File

@ -1,253 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
use psb_base_mod
use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_seti
use mld_c_base_aggregator_mod
use mld_c_dec_aggregator_mod
use mld_c_symdec_aggregator_mod
use mld_c_jac_smoother
use mld_c_as_smoother
use mld_c_diag_solver
use mld_c_ilu_solver
use mld_c_id_solver
use mld_c_gs_solver
#if defined(HAVE_SLU_)
use mld_c_slu_solver
#endif
#if defined(HAVE_MUMPS_)
use mld_c_mumps_solver
#endif
Implicit None
! Arguments
class(mld_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='c_base_onelev_seti'
type(mld_c_base_smoother_type) :: mld_c_base_smoother_mold
type(mld_c_jac_smoother_type) :: mld_c_jac_smoother_mold
type(mld_c_as_smoother_type) :: mld_c_as_smoother_mold
type(mld_c_diag_solver_type) :: mld_c_diag_solver_mold
type(mld_c_ilu_solver_type) :: mld_c_ilu_solver_mold
type(mld_c_id_solver_type) :: mld_c_id_solver_mold
type(mld_c_gs_solver_type) :: mld_c_gs_solver_mold
type(mld_c_bwgs_solver_type) :: mld_c_bwgs_solver_mold
#if defined(HAVE_SLU_)
type(mld_c_slu_solver_type) :: mld_c_slu_solver_mold
#endif
#if defined(HAVE_MUMPS_)
type(mld_c_mumps_solver_type) :: mld_c_mumps_solver_mold
#endif
call psb_erractionsave(err_act)
info = psb_success_
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_smooth_post_
case default
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_smooth_both_
end if
select case (what)
case (mld_smoother_type_)
select case (val)
case (mld_noprec_)
call lv%set(mld_c_base_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_c_id_solver_mold,info,pos=pos)
case (mld_jac_)
call lv%set(mld_c_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_c_diag_solver_mold,info,pos=pos)
case (mld_bjac_)
call lv%set(mld_c_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos)
case (mld_as_)
call lv%set(mld_c_as_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos)
case (mld_fbgs_)
call lv%set(mld_c_jac_smoother_mold,info,pos='pre')
if (info == 0) call lv%set(mld_c_gs_solver_mold,info,pos='pre')
if (info == 0) call lv%set(mld_c_jac_smoother_mold,info,pos='post')
if (info == 0) call lv%set(mld_c_bwgs_solver_mold,info,pos='post')
case default
!
! Do nothing and hope for the best :)
!
end select
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
case(mld_sub_solve_)
select case (val)
case (mld_f_none_)
call lv%set(mld_c_id_solver_mold,info,pos=pos)
case (mld_diag_scale_)
call lv%set(mld_c_diag_solver_mold,info,pos=pos)
case (mld_gs_)
call lv%set(mld_c_gs_solver_mold,info,pos=pos)
case (mld_bwgs_)
call lv%set(mld_c_bwgs_solver_mold,info,pos=pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_c_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
#ifdef HAVE_SLU_
case (mld_slu_)
call lv%set(mld_c_slu_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_
case (mld_mumps_)
call lv%set(mld_c_mumps_solver_mold,info,pos=pos)
#endif
case default
!
! Do nothing and hope for the best :)
!
end select
case (mld_smoother_sweeps_)
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_pre = val
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_post = val
case (mld_ml_cycle_)
lv%parms%ml_cycle = val
case (mld_par_aggr_alg_)
lv%parms%par_aggr_alg = val
if (allocated(lv%aggr)) then
call lv%aggr%free(info)
if (info == 0) deallocate(lv%aggr,stat=info)
if (info /= 0) then
info = psb_err_internal_error_
return
end if
end if
select case(val)
case(mld_dec_aggr_)
allocate(mld_c_dec_aggregator_type :: lv%aggr, stat=info)
case(mld_sym_dec_aggr_)
allocate(mld_c_symdec_aggregator_type :: lv%aggr, stat=info)
case default
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case (mld_aggr_ord_)
lv%parms%aggr_ord = val
case (mld_aggr_type_)
lv%parms%aggr_type = val
if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info)
case (mld_aggr_prol_)
lv%parms%aggr_prol = val
case (mld_coarse_mat_)
lv%parms%coarse_mat = val
case (mld_aggr_omega_alg_)
lv%parms%aggr_omega_alg= val
case (mld_aggr_eig_)
lv%parms%aggr_eig = val
case (mld_aggr_filter_)
lv%parms%aggr_filter = val
case (mld_coarse_solve_)
lv%parms%coarse_solve = val
case default
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
end if
end select
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_c_base_onelev_seti

104
mlprec/impl/level/mld_c_base_onelev_setr.f90
Unescape Escape View File

@ -1,104 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_onelev_setr(lv,what,val,info,pos)
use psb_base_mod
use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_setr
Implicit None
! Arguments
class(mld_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='c_base_onelev_setr'
call psb_erractionsave(err_act)
info = psb_success_
select case (what)
case (mld_aggr_omega_val_)
lv%parms%aggr_omega_val= val
case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val
case default
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_smooth_post_
case default
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
end if
end select
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_c_base_onelev_setr

8
mlprec/impl/level/mld_d_base_onelev_csetc.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos)
subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos,idx)
use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_csetc
@ -48,6 +48,7 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos)
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_csetc'
@ -77,15 +78,16 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos)
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if
if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx)
end if

8
mlprec/impl/level/mld_d_base_onelev_cseti.F90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos,idx)
use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_cseti
@ -69,6 +69,7 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_cseti'
@ -252,14 +253,15 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
case default
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if
if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx)
end select
if (info /= psb_success_) goto 9999

9
mlprec/impl/level/mld_d_base_onelev_csetr.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos)
subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos,idx)
use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_csetr
@ -48,6 +48,7 @@ subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos)
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_csetr'
@ -82,14 +83,16 @@ subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos)
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if
if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx)
end select
if (info /= psb_success_) goto 9999

99
mlprec/impl/level/mld_d_base_onelev_setc.f90
Unescape Escape View File

@ -1,99 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_onelev_setc(lv,what,val,info,pos)
use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_setc
Implicit None
! Arguments
class(mld_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_setc'
integer(psb_ipk_) :: ival
call psb_erractionsave(err_act)
info = psb_success_
ival = lv%stringval(val)
if (ival >= 0) then
call lv%set(what,ival,info,pos=pos)
else
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_smooth_post_
case default
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
end if
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_d_base_onelev_setc

273
mlprec/impl/level/mld_d_base_onelev_seti.F90
Unescape Escape View File

@ -1,273 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_seti
use mld_d_base_aggregator_mod
use mld_d_dec_aggregator_mod
use mld_d_symdec_aggregator_mod
use mld_d_jac_smoother
use mld_d_as_smoother
use mld_d_diag_solver
use mld_d_ilu_solver
use mld_d_id_solver
use mld_d_gs_solver
#if defined(HAVE_UMF_)
use mld_d_umf_solver
#endif
#if defined(HAVE_SLUDIST_)
use mld_d_sludist_solver
#endif
#if defined(HAVE_SLU_)
use mld_d_slu_solver
#endif
#if defined(HAVE_MUMPS_)
use mld_d_mumps_solver
#endif
Implicit None
! Arguments
class(mld_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_seti'
type(mld_d_base_smoother_type) :: mld_d_base_smoother_mold
type(mld_d_jac_smoother_type) :: mld_d_jac_smoother_mold
type(mld_d_as_smoother_type) :: mld_d_as_smoother_mold
type(mld_d_diag_solver_type) :: mld_d_diag_solver_mold
type(mld_d_ilu_solver_type) :: mld_d_ilu_solver_mold
type(mld_d_id_solver_type) :: mld_d_id_solver_mold
type(mld_d_gs_solver_type) :: mld_d_gs_solver_mold
type(mld_d_bwgs_solver_type) :: mld_d_bwgs_solver_mold
#if defined(HAVE_UMF_)
type(mld_d_umf_solver_type) :: mld_d_umf_solver_mold
#endif
#if defined(HAVE_SLUDIST_)
type(mld_d_sludist_solver_type) :: mld_d_sludist_solver_mold
#endif
#if defined(HAVE_SLU_)
type(mld_d_slu_solver_type) :: mld_d_slu_solver_mold
#endif
#if defined(HAVE_MUMPS_)
type(mld_d_mumps_solver_type) :: mld_d_mumps_solver_mold
#endif
call psb_erractionsave(err_act)
info = psb_success_
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_smooth_post_
case default
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_smooth_both_
end if
select case (what)
case (mld_smoother_type_)
select case (val)
case (mld_noprec_)
call lv%set(mld_d_base_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_d_id_solver_mold,info,pos=pos)
case (mld_jac_)
call lv%set(mld_d_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_d_diag_solver_mold,info,pos=pos)
case (mld_bjac_)
call lv%set(mld_d_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_d_ilu_solver_mold,info,pos=pos)
case (mld_as_)
call lv%set(mld_d_as_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_d_ilu_solver_mold,info,pos=pos)
case (mld_fbgs_)
call lv%set(mld_d_jac_smoother_mold,info,pos='pre')
if (info == 0) call lv%set(mld_d_gs_solver_mold,info,pos='pre')
if (info == 0) call lv%set(mld_d_jac_smoother_mold,info,pos='post')
if (info == 0) call lv%set(mld_d_bwgs_solver_mold,info,pos='post')
case default
!
! Do nothing and hope for the best :)
!
end select
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
case(mld_sub_solve_)
select case (val)
case (mld_f_none_)
call lv%set(mld_d_id_solver_mold,info,pos=pos)
case (mld_diag_scale_)
call lv%set(mld_d_diag_solver_mold,info,pos=pos)
case (mld_gs_)
call lv%set(mld_d_gs_solver_mold,info,pos=pos)
case (mld_bwgs_)
call lv%set(mld_d_bwgs_solver_mold,info,pos=pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_d_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
#ifdef HAVE_SLU_
case (mld_slu_)
call lv%set(mld_d_slu_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_
case (mld_mumps_)
call lv%set(mld_d_mumps_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_d_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_UMF_
case (mld_umf_)
call lv%set(mld_d_umf_solver_mold,info,pos=pos)
#endif
case default
!
! Do nothing and hope for the best :)
!
end select
case (mld_smoother_sweeps_)
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_pre = val
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_post = val
case (mld_ml_cycle_)
lv%parms%ml_cycle = val
case (mld_par_aggr_alg_)
lv%parms%par_aggr_alg = val
if (allocated(lv%aggr)) then
call lv%aggr%free(info)
if (info == 0) deallocate(lv%aggr,stat=info)
if (info /= 0) then
info = psb_err_internal_error_
return
end if
end if
select case(val)
case(mld_dec_aggr_)
allocate(mld_d_dec_aggregator_type :: lv%aggr, stat=info)
case(mld_sym_dec_aggr_)
allocate(mld_d_symdec_aggregator_type :: lv%aggr, stat=info)
case default
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case (mld_aggr_ord_)
lv%parms%aggr_ord = val
case (mld_aggr_type_)
lv%parms%aggr_type = val
if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info)
case (mld_aggr_prol_)
lv%parms%aggr_prol = val
case (mld_coarse_mat_)
lv%parms%coarse_mat = val
case (mld_aggr_omega_alg_)
lv%parms%aggr_omega_alg= val
case (mld_aggr_eig_)
lv%parms%aggr_eig = val
case (mld_aggr_filter_)
lv%parms%aggr_filter = val
case (mld_coarse_solve_)
lv%parms%coarse_solve = val
case default
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
end if
end select
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_d_base_onelev_seti

104
mlprec/impl/level/mld_d_base_onelev_setr.f90
Unescape Escape View File

@ -1,104 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_onelev_setr(lv,what,val,info,pos)
use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_setr
Implicit None
! Arguments
class(mld_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_setr'
call psb_erractionsave(err_act)
info = psb_success_
select case (what)
case (mld_aggr_omega_val_)
lv%parms%aggr_omega_val= val
case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val
case default
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_smooth_post_
case default
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
end if
end select
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_d_base_onelev_setr

8
mlprec/impl/level/mld_s_base_onelev_csetc.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos)
subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos,idx)
use psb_base_mod
use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_csetc
@ -48,6 +48,7 @@ subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos)
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='s_base_onelev_csetc'
@ -77,15 +78,16 @@ subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos)
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if
if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx)
end if

8
mlprec/impl/level/mld_s_base_onelev_cseti.F90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos,idx)
use psb_base_mod
use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_cseti
@ -63,6 +63,7 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='s_base_onelev_cseti'
@ -232,14 +233,15 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
case default
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if
if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx)
end select
if (info /= psb_success_) goto 9999

9
mlprec/impl/level/mld_s_base_onelev_csetr.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos)
subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos,idx)
use psb_base_mod
use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_csetr
@ -48,6 +48,7 @@ subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos)
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='s_base_onelev_csetr'
@ -82,14 +83,16 @@ subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos)
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if
if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx)
end select
if (info /= psb_success_) goto 9999

99
mlprec/impl/level/mld_s_base_onelev_setc.f90
Unescape Escape View File

@ -1,99 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_base_onelev_setc(lv,what,val,info,pos)
use psb_base_mod
use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_setc
Implicit None
! Arguments
class(mld_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='s_base_onelev_setc'
integer(psb_ipk_) :: ival
call psb_erractionsave(err_act)
info = psb_success_
ival = lv%stringval(val)
if (ival >= 0) then
call lv%set(what,ival,info,pos=pos)
else
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_smooth_post_
case default
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
end if
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_s_base_onelev_setc

253
mlprec/impl/level/mld_s_base_onelev_seti.F90
Unescape Escape View File

@ -1,253 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
use psb_base_mod
use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_seti
use mld_s_base_aggregator_mod
use mld_s_dec_aggregator_mod
use mld_s_symdec_aggregator_mod
use mld_s_jac_smoother
use mld_s_as_smoother
use mld_s_diag_solver
use mld_s_ilu_solver
use mld_s_id_solver
use mld_s_gs_solver
#if defined(HAVE_SLU_)
use mld_s_slu_solver
#endif
#if defined(HAVE_MUMPS_)
use mld_s_mumps_solver
#endif
Implicit None
! Arguments
class(mld_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='s_base_onelev_seti'
type(mld_s_base_smoother_type) :: mld_s_base_smoother_mold
type(mld_s_jac_smoother_type) :: mld_s_jac_smoother_mold
type(mld_s_as_smoother_type) :: mld_s_as_smoother_mold
type(mld_s_diag_solver_type) :: mld_s_diag_solver_mold
type(mld_s_ilu_solver_type) :: mld_s_ilu_solver_mold
type(mld_s_id_solver_type) :: mld_s_id_solver_mold
type(mld_s_gs_solver_type) :: mld_s_gs_solver_mold
type(mld_s_bwgs_solver_type) :: mld_s_bwgs_solver_mold
#if defined(HAVE_SLU_)
type(mld_s_slu_solver_type) :: mld_s_slu_solver_mold
#endif
#if defined(HAVE_MUMPS_)
type(mld_s_mumps_solver_type) :: mld_s_mumps_solver_mold
#endif
call psb_erractionsave(err_act)
info = psb_success_
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_smooth_post_
case default
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_smooth_both_
end if
select case (what)
case (mld_smoother_type_)
select case (val)
case (mld_noprec_)
call lv%set(mld_s_base_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_s_id_solver_mold,info,pos=pos)
case (mld_jac_)
call lv%set(mld_s_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_s_diag_solver_mold,info,pos=pos)
case (mld_bjac_)
call lv%set(mld_s_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos)
case (mld_as_)
call lv%set(mld_s_as_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos)
case (mld_fbgs_)
call lv%set(mld_s_jac_smoother_mold,info,pos='pre')
if (info == 0) call lv%set(mld_s_gs_solver_mold,info,pos='pre')
if (info == 0) call lv%set(mld_s_jac_smoother_mold,info,pos='post')
if (info == 0) call lv%set(mld_s_bwgs_solver_mold,info,pos='post')
case default
!
! Do nothing and hope for the best :)
!
end select
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
case(mld_sub_solve_)
select case (val)
case (mld_f_none_)
call lv%set(mld_s_id_solver_mold,info,pos=pos)
case (mld_diag_scale_)
call lv%set(mld_s_diag_solver_mold,info,pos=pos)
case (mld_gs_)
call lv%set(mld_s_gs_solver_mold,info,pos=pos)
case (mld_bwgs_)
call lv%set(mld_s_bwgs_solver_mold,info,pos=pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_s_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
#ifdef HAVE_SLU_
case (mld_slu_)
call lv%set(mld_s_slu_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_
case (mld_mumps_)
call lv%set(mld_s_mumps_solver_mold,info,pos=pos)
#endif
case default
!
! Do nothing and hope for the best :)
!
end select
case (mld_smoother_sweeps_)
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_pre = val
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_post = val
case (mld_ml_cycle_)
lv%parms%ml_cycle = val
case (mld_par_aggr_alg_)
lv%parms%par_aggr_alg = val
if (allocated(lv%aggr)) then
call lv%aggr%free(info)
if (info == 0) deallocate(lv%aggr,stat=info)
if (info /= 0) then
info = psb_err_internal_error_
return
end if
end if
select case(val)
case(mld_dec_aggr_)
allocate(mld_s_dec_aggregator_type :: lv%aggr, stat=info)
case(mld_sym_dec_aggr_)
allocate(mld_s_symdec_aggregator_type :: lv%aggr, stat=info)
case default
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case (mld_aggr_ord_)
lv%parms%aggr_ord = val
case (mld_aggr_type_)
lv%parms%aggr_type = val
if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info)
case (mld_aggr_prol_)
lv%parms%aggr_prol = val
case (mld_coarse_mat_)
lv%parms%coarse_mat = val
case (mld_aggr_omega_alg_)
lv%parms%aggr_omega_alg= val
case (mld_aggr_eig_)
lv%parms%aggr_eig = val
case (mld_aggr_filter_)
lv%parms%aggr_filter = val
case (mld_coarse_solve_)
lv%parms%coarse_solve = val
case default
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
end if
end select
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_s_base_onelev_seti

104
mlprec/impl/level/mld_s_base_onelev_setr.f90
Unescape Escape View File

@ -1,104 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_base_onelev_setr(lv,what,val,info,pos)
use psb_base_mod
use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_setr
Implicit None
! Arguments
class(mld_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='s_base_onelev_setr'
call psb_erractionsave(err_act)
info = psb_success_
select case (what)
case (mld_aggr_omega_val_)
lv%parms%aggr_omega_val= val
case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val
case default
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_smooth_post_
case default
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
end if
end select
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_s_base_onelev_setr

8
mlprec/impl/level/mld_z_base_onelev_csetc.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos)
subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos,idx)
use psb_base_mod
use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_csetc
@ -48,6 +48,7 @@ subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos)
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='z_base_onelev_csetc'
@ -77,15 +78,16 @@ subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos)
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if
if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx)
end if

8
mlprec/impl/level/mld_z_base_onelev_cseti.F90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos)
subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos,idx)
use psb_base_mod
use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_cseti
@ -69,6 +69,7 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos)
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='z_base_onelev_cseti'
@ -252,14 +253,15 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos)
case default
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if
if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx)
end select
if (info /= psb_success_) goto 9999

9
mlprec/impl/level/mld_z_base_onelev_csetr.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos)
subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos,idx)
use psb_base_mod
use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_csetr
@ -48,6 +48,7 @@ subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos)
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='z_base_onelev_csetr'
@ -82,14 +83,16 @@ subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos)
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if
if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx)
end select
if (info /= psb_success_) goto 9999

99
mlprec/impl/level/mld_z_base_onelev_setc.f90
Unescape Escape View File

@ -1,99 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_z_base_onelev_setc(lv,what,val,info,pos)
use psb_base_mod
use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_setc
Implicit None
! Arguments
class(mld_z_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='z_base_onelev_setc'
integer(psb_ipk_) :: ival
call psb_erractionsave(err_act)
info = psb_success_
ival = lv%stringval(val)
if (ival >= 0) then
call lv%set(what,ival,info,pos=pos)
else
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_smooth_post_
case default
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
end if
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_z_base_onelev_setc

273
mlprec/impl/level/mld_z_base_onelev_seti.F90
Unescape Escape View File

@ -1,273 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_z_base_onelev_seti(lv,what,val,info,pos)
use psb_base_mod
use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_seti
use mld_z_base_aggregator_mod
use mld_z_dec_aggregator_mod
use mld_z_symdec_aggregator_mod
use mld_z_jac_smoother
use mld_z_as_smoother
use mld_z_diag_solver
use mld_z_ilu_solver
use mld_z_id_solver
use mld_z_gs_solver
#if defined(HAVE_UMF_)
use mld_z_umf_solver
#endif
#if defined(HAVE_SLUDIST_)
use mld_z_sludist_solver
#endif
#if defined(HAVE_SLU_)
use mld_z_slu_solver
#endif
#if defined(HAVE_MUMPS_)
use mld_z_mumps_solver
#endif
Implicit None
! Arguments
class(mld_z_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='z_base_onelev_seti'
type(mld_z_base_smoother_type) :: mld_z_base_smoother_mold
type(mld_z_jac_smoother_type) :: mld_z_jac_smoother_mold
type(mld_z_as_smoother_type) :: mld_z_as_smoother_mold
type(mld_z_diag_solver_type) :: mld_z_diag_solver_mold
type(mld_z_ilu_solver_type) :: mld_z_ilu_solver_mold
type(mld_z_id_solver_type) :: mld_z_id_solver_mold
type(mld_z_gs_solver_type) :: mld_z_gs_solver_mold
type(mld_z_bwgs_solver_type) :: mld_z_bwgs_solver_mold
#if defined(HAVE_UMF_)
type(mld_z_umf_solver_type) :: mld_z_umf_solver_mold
#endif
#if defined(HAVE_SLUDIST_)
type(mld_z_sludist_solver_type) :: mld_z_sludist_solver_mold
#endif
#if defined(HAVE_SLU_)
type(mld_z_slu_solver_type) :: mld_z_slu_solver_mold
#endif
#if defined(HAVE_MUMPS_)
type(mld_z_mumps_solver_type) :: mld_z_mumps_solver_mold
#endif
call psb_erractionsave(err_act)
info = psb_success_
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_smooth_post_
case default
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_smooth_both_
end if
select case (what)
case (mld_smoother_type_)
select case (val)
case (mld_noprec_)
call lv%set(mld_z_base_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_z_id_solver_mold,info,pos=pos)
case (mld_jac_)
call lv%set(mld_z_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_z_diag_solver_mold,info,pos=pos)
case (mld_bjac_)
call lv%set(mld_z_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos)
case (mld_as_)
call lv%set(mld_z_as_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos)
case (mld_fbgs_)
call lv%set(mld_z_jac_smoother_mold,info,pos='pre')
if (info == 0) call lv%set(mld_z_gs_solver_mold,info,pos='pre')
if (info == 0) call lv%set(mld_z_jac_smoother_mold,info,pos='post')
if (info == 0) call lv%set(mld_z_bwgs_solver_mold,info,pos='post')
case default
!
! Do nothing and hope for the best :)
!
end select
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
case(mld_sub_solve_)
select case (val)
case (mld_f_none_)
call lv%set(mld_z_id_solver_mold,info,pos=pos)
case (mld_diag_scale_)
call lv%set(mld_z_diag_solver_mold,info,pos=pos)
case (mld_gs_)
call lv%set(mld_z_gs_solver_mold,info,pos=pos)
case (mld_bwgs_)
call lv%set(mld_z_bwgs_solver_mold,info,pos=pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_z_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
#ifdef HAVE_SLU_
case (mld_slu_)
call lv%set(mld_z_slu_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_
case (mld_mumps_)
call lv%set(mld_z_mumps_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_z_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_UMF_
case (mld_umf_)
call lv%set(mld_z_umf_solver_mold,info,pos=pos)
#endif
case default
!
! Do nothing and hope for the best :)
!
end select
case (mld_smoother_sweeps_)
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_pre = val
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_post = val
case (mld_ml_cycle_)
lv%parms%ml_cycle = val
case (mld_par_aggr_alg_)
lv%parms%par_aggr_alg = val
if (allocated(lv%aggr)) then
call lv%aggr%free(info)
if (info == 0) deallocate(lv%aggr,stat=info)
if (info /= 0) then
info = psb_err_internal_error_
return
end if
end if
select case(val)
case(mld_dec_aggr_)
allocate(mld_z_dec_aggregator_type :: lv%aggr, stat=info)
case(mld_sym_dec_aggr_)
allocate(mld_z_symdec_aggregator_type :: lv%aggr, stat=info)
case default
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case (mld_aggr_ord_)
lv%parms%aggr_ord = val
case (mld_aggr_type_)
lv%parms%aggr_type = val
if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info)
case (mld_aggr_prol_)
lv%parms%aggr_prol = val
case (mld_coarse_mat_)
lv%parms%coarse_mat = val
case (mld_aggr_omega_alg_)
lv%parms%aggr_omega_alg= val
case (mld_aggr_eig_)
lv%parms%aggr_eig = val
case (mld_aggr_filter_)
lv%parms%aggr_filter = val
case (mld_coarse_solve_)
lv%parms%coarse_solve = val
case default
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
end if
end select
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_z_base_onelev_seti

104
mlprec/impl/level/mld_z_base_onelev_setr.f90
Unescape Escape View File

@ -1,104 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_z_base_onelev_setr(lv,what,val,info,pos)
use psb_base_mod
use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_setr
Implicit None
! Arguments
class(mld_z_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='z_base_onelev_setr'
call psb_erractionsave(err_act)
info = psb_success_
select case (what)
case (mld_aggr_omega_val_)
lv%parms%aggr_omega_val= val
case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val
case default
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_smooth_post_
case default
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
end if
end select
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_z_base_onelev_setr

1
mlprec/impl/mld_c_hierarchy_bld.f90
Unescape Escape View File

@ -444,6 +444,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
iszv = size(prec%precv)
call prec%cmp_complexity()
call prec%cmp_avg_cr()
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&

21
mlprec/impl/mld_ccprecset.F90
Unescape Escape View File

@ -75,7 +75,7 @@
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos)
subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use mld_c_prec_mod, mld_protect_name => mld_ccprecseti
@ -102,6 +102,7 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local variables
integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il
@ -283,7 +284,7 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos)
case default
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
call p%precv(il)%set(what,val,info,pos=pos,idx=idx)
end do
end select
@ -410,7 +411,7 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos)
case default
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos)
call p%precv(ilev_)%set(what,val,info,pos=pos,idx=idx)
end do
end select
@ -457,7 +458,7 @@ end subroutine mld_ccprecseti
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos)
subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
use psb_base_mod
use mld_c_prec_mod, mld_protect_name => mld_ccprecsetc
@ -471,6 +472,7 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local variables
integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il
@ -486,7 +488,7 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos)
if (val >=0) then
call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos)
call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos,idx=idx)
else
nlev_ = size(p%precv)
@ -515,7 +517,7 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos)
return
endif
do il=ilev_, ilmax_
call p%precv(il)%set(what,string,info,pos=pos)
call p%precv(il)%set(what,string,info,pos=pos,idx=idx)
end do
end if
@ -560,7 +562,7 @@ end subroutine mld_ccprecsetc
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_ccprecsetr(p,what,val,info,ilev,ilmax,pos)
subroutine mld_ccprecsetr(p,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use mld_c_prec_mod, mld_protect_name => mld_ccprecsetr
@ -574,6 +576,7 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev,ilmax,pos)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local variables
integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il
@ -634,7 +637,7 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev,ilmax,pos)
if (present(ilev)) then
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
call p%precv(il)%set(what,val,info,pos=pos,idx=idx)
end do
else if (.not.present(ilev)) then
@ -650,7 +653,7 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev,ilmax,pos)
case default
do il=1,nlev_
call p%precv(il)%set(what,val,info,pos=pos)
call p%precv(il)%set(what,val,info,pos=pos,idx=idx)
end do
end select

1
mlprec/impl/mld_cfile_prec_descr.f90
Unescape Escape View File

@ -172,6 +172,7 @@ subroutine mld_cfile_prec_descr(prec,iout,root)
write(iout_,*) 'Multilevel hierarchy: '
write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',prec%get_complexity()
write(iout_,*) ' Average coarsening : ',prec%get_avg_cr()
ilmin = 2
if (nlev == 2) ilmin=1
do ilev=ilmin,nlev

4
mlprec/impl/mld_cprecinit.F90
Unescape Escape View File

@ -83,7 +83,7 @@
! info - integer, output.
! Error code.
!
subroutine mld_cprecinit(prec,ptype,info)
subroutine mld_cprecinit(ictxt,prec,ptype,info)
use psb_base_mod
use mld_c_prec_mod, mld_protect_name => mld_cprecinit
@ -101,6 +101,7 @@ subroutine mld_cprecinit(prec,ptype,info)
implicit none
! Arguments
integer(psb_ipk_), intent(in) :: ictxt
class(mld_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
@ -117,6 +118,7 @@ subroutine mld_cprecinit(prec,ptype,info)
! Do we want to do something?
endif
endif
prec%ictxt = ictxt
prec%min_coarse_size = -1
select case(psb_toupper(ptype(1:len_trim(ptype))))

627
mlprec/impl/mld_cprecset.F90
Unescape Escape View File

@ -37,385 +37,6 @@
!
! File: mld_cprecset.f90
!
! Subroutine: mld_cprecseti
! Version: complex
!
! This routine sets the integer parameters defining the preconditioner. More
! precisely, the integer parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set character and complex parameters, see mld_cprecsetc and mld_cprecsetr,
! respectively.
!
!
! Arguments:
! p - type(mld_cprec_type), input/output.
! The preconditioner data structure.
! what - integer, input.
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! val - integer, input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the appropriate levels.
!
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
! of the same parameter at different levels 1,...,nlev-1, even in cases where
! the parameter must have the same value at all the levels but the coarsest one.
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_cprecseti(p,what,val,info,ilev,ilmax,pos)
use psb_base_mod
use mld_c_prec_mod, mld_protect_name => mld_cprecseti
use mld_c_jac_smoother
use mld_c_as_smoother
use mld_c_diag_solver
use mld_c_ilu_solver
use mld_c_id_solver
use mld_c_gs_solver
#if defined(HAVE_SLU_)
use mld_c_slu_solver
#endif
#if defined(HAVE_MUMPS_)
use mld_c_mumps_solver
#endif
implicit none
! Arguments
class(mld_cprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
! Local variables
integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il
character(len=*), parameter :: name='mld_precseti'
info = psb_success_
if (.not.allocated(p%precv)) then
info = 3111
write(psb_err_unit,*) name,&
& ': Error: uninitialized preconditioner,',&
&' should call MLD_PRECINIT'
return
endif
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
if (present(ilmax)) then
ilmax_ = ilmax
else
ilmax_ = ilev_
end if
else
ilev_ = 1
ilmax_ = ilev_
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if ((ilmax_<1).or.(ilmax_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_
return
endif
select case(what)
case (mld_min_coarse_size_)
p%min_coarse_size = max(val,-1)
return
case(mld_max_levs_)
p%max_levs = max(val,1)
return
case(mld_outer_sweeps_)
p%outer_sweeps = max(val,1)
return
end select
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,&
& mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,&
& mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_sub_restr_,mld_sub_prol_, &
& mld_sub_ovr_,mld_sub_fillin_,&
& mld_coarse_mat_)
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
end do
case(mld_coarse_subsolve_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
call p%precv(ilev_)%set(mld_sub_solve_,val,info,pos=pos)
case(mld_coarse_solve_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set(mld_smoother_type_,val,info,pos=pos)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_slu_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_mumps_)
#if defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_umf_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_sludist_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_jac_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
end select
endif
case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos)
case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos)
case default
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
end do
end select
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ovr_,mld_sub_fillin_,&
& mld_smoother_sweeps_,mld_smoother_type_)
do ilev_=1,max(1,nlev_-1)
call p%precv(ilev_)%set(what,val,info,pos=pos)
if (info /= 0) return
end do
case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,&
& mld_aggr_eig_,mld_aggr_filter_)
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
case(mld_coarse_mat_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_coarse_mat_,val,info,pos=pos)
end if
case(mld_coarse_solve_)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
case(mld_slu_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_mumps_)
#if defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_umf_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_sludist_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_jac_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
end select
endif
case(mld_coarse_subsolve_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
endif
case(mld_coarse_sweeps_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos)
end if
case(mld_coarse_fillin_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos)
end if
case default
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
end select
endif
end subroutine mld_cprecseti
subroutine mld_cprecsetsm(p,val,info,ilev,ilmax,pos)
use psb_base_mod
@ -606,251 +227,3 @@ subroutine mld_cprecsetag(p,val,info,ilev,ilmax,pos)
end subroutine mld_cprecsetag
!
! Subroutine: mld_cprecsetc
! Version: complex
!
! This routine sets the character parameters defining the preconditioner. More
! precisely, the character parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and complex parameters, see mld_cprecseti and mld_cprecsetr,
! respectively.
!
!
! Arguments:
! p - type(mld_cprec_type), input/output.
! The preconditioner data structure.
! what - integer, input.
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! string - character(len=*), input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the appropriate levels.
!
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
! of the same parameter at different levels 1,...,nlev-1, even in cases where
! the parameter must have the same value at all the levels but the coarsest one.
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_cprecsetc(p,what,string,info,ilev,ilmax,pos)
use psb_base_mod
use mld_c_prec_mod, mld_protect_name => mld_cprecsetc
implicit none
! Arguments
class(mld_cprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
! Local variables
integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il
character(len=*), parameter :: name='mld_precsetc'
info = psb_success_
if (.not.allocated(p%precv)) then
info = 3111
return
endif
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
else
ilev_ = 1
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
write(psb_err_unit,*) name,&
& ': Error: invalid ILEV/NLEV combination',ilev_, nlev_
info = -1
return
endif
val = mld_stringval(string)
if (val >=0) then
call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos)
else
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
if (present(ilmax)) then
ilmax_ = ilmax
else
ilmax_ = ilev_
end if
else
ilev_ = 1
ilmax_ = ilev_
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if ((ilmax_<1).or.(ilmax_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_
return
endif
do il=ilev_, ilmax_
call p%precv(il)%set(what,string,info,pos=pos)
end do
end if
end subroutine mld_cprecsetc
!
! Subroutine: mld_cprecsetr
! Version: complex
!
! This routine sets the complex parameters defining the preconditioner. More
! precisely, the complex parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and character parameters, see mld_cprecseti and mld_cprecsetc,
! respectively.
!
! Arguments:
! p - type(mld_cprec_type), input/output.
! The preconditioner data structure.
! what - integer, input.
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! val - real(psb_spk_), input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the appropriate levels.
!
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
! of the same parameter at different levels 1,...,nlev-1, even in cases where
! the parameter must have the same value at all the levels but the coarsest one.
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_cprecsetr(p,what,val,info,ilev,ilmax,pos)
use psb_base_mod
use mld_c_prec_mod, mld_protect_name => mld_cprecsetr
implicit none
! Arguments
class(mld_cprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
! Local variables
integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il
real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precsetr'
info = psb_success_
select case(what)
case (mld_min_cr_ratio_)
p%min_cr_ratio = max(sone,val)
return
end select
if (.not.allocated(p%precv)) then
write(psb_err_unit,*) name,&
&': Error: uninitialized preconditioner,',&
&' should call MLD_PRECINIT'
info = 3111
return
endif
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
if (present(ilmax)) then
ilmax_ = ilmax
else
ilmax_ = ilev_
end if
else
ilev_ = 1
ilmax_ = ilev_
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if ((ilmax_<1).or.(ilmax_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_
return
endif
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
end do
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate levels
!
select case(what)
case(mld_coarse_iluthrs_)
ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos)
case default
do il=1,nlev_
call p%precv(il)%set(what,val,info,pos=pos)
end do
end select
endif
end subroutine mld_cprecsetr

1
mlprec/impl/mld_d_hierarchy_bld.f90
Unescape Escape View File

@ -444,6 +444,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
iszv = size(prec%precv)
call prec%cmp_complexity()
call prec%cmp_avg_cr()
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&

21
mlprec/impl/mld_dcprecset.F90
Unescape Escape View File

@ -75,7 +75,7 @@
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos)
subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use mld_d_prec_mod, mld_protect_name => mld_dcprecseti
@ -108,6 +108,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local variables
integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il
@ -303,7 +304,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos)
case default
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
call p%precv(il)%set(what,val,info,pos=pos,idx=idx)
end do
end select
@ -444,7 +445,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos)
case default
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos)
call p%precv(ilev_)%set(what,val,info,pos=pos,idx=idx)
end do
end select
@ -491,7 +492,7 @@ end subroutine mld_dcprecseti
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos)
subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
use psb_base_mod
use mld_d_prec_mod, mld_protect_name => mld_dcprecsetc
@ -505,6 +506,7 @@ subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local variables
integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il
@ -520,7 +522,7 @@ subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos)
if (val >=0) then
call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos)
call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos,idx=idx)
else
nlev_ = size(p%precv)
@ -549,7 +551,7 @@ subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos)
return
endif
do il=ilev_, ilmax_
call p%precv(il)%set(what,string,info,pos=pos)
call p%precv(il)%set(what,string,info,pos=pos,idx=idx)
end do
end if
@ -594,7 +596,7 @@ end subroutine mld_dcprecsetc
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_dcprecsetr(p,what,val,info,ilev,ilmax,pos)
subroutine mld_dcprecsetr(p,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use mld_d_prec_mod, mld_protect_name => mld_dcprecsetr
@ -608,6 +610,7 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev,ilmax,pos)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local variables
integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il
@ -668,7 +671,7 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev,ilmax,pos)
if (present(ilev)) then
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
call p%precv(il)%set(what,val,info,pos=pos,idx=idx)
end do
else if (.not.present(ilev)) then
@ -684,7 +687,7 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev,ilmax,pos)
case default
do il=1,nlev_
call p%precv(il)%set(what,val,info,pos=pos)
call p%precv(il)%set(what,val,info,pos=pos,idx=idx)
end do
end select

1
mlprec/impl/mld_dfile_prec_descr.f90
Unescape Escape View File

@ -172,6 +172,7 @@ subroutine mld_dfile_prec_descr(prec,iout,root)
write(iout_,*) 'Multilevel hierarchy: '
write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',prec%get_complexity()
write(iout_,*) ' Average coarsening : ',prec%get_avg_cr()
ilmin = 2
if (nlev == 2) ilmin=1
do ilev=ilmin,nlev

4
mlprec/impl/mld_dprecinit.F90
Unescape Escape View File

@ -83,7 +83,7 @@
! info - integer, output.
! Error code.
!
subroutine mld_dprecinit(prec,ptype,info)
subroutine mld_dprecinit(ictxt,prec,ptype,info)
use psb_base_mod
use mld_d_prec_mod, mld_protect_name => mld_dprecinit
@ -104,6 +104,7 @@ subroutine mld_dprecinit(prec,ptype,info)
implicit none
! Arguments
integer(psb_ipk_), intent(in) :: ictxt
class(mld_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
@ -120,6 +121,7 @@ subroutine mld_dprecinit(prec,ptype,info)
! Do we want to do something?
endif
endif
prec%ictxt = ictxt
prec%min_coarse_size = -1
select case(psb_toupper(ptype(1:len_trim(ptype))))

660
mlprec/impl/mld_dprecset.F90
Unescape Escape View File

@ -37,418 +37,6 @@
!
! File: mld_dprecset.f90
!
! Subroutine: mld_dprecseti
! Version: real
!
! This routine sets the integer parameters defining the preconditioner. More
! precisely, the integer parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set character and real parameters, see mld_dprecsetc and mld_dprecsetr,
! respectively.
!
!
! Arguments:
! p - type(mld_dprec_type), input/output.
! The preconditioner data structure.
! what - integer, input.
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! val - integer, input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the appropriate levels.
!
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
! of the same parameter at different levels 1,...,nlev-1, even in cases where
! the parameter must have the same value at all the levels but the coarsest one.
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_dprecseti(p,what,val,info,ilev,ilmax,pos)
use psb_base_mod
use mld_d_prec_mod, mld_protect_name => mld_dprecseti
use mld_d_jac_smoother
use mld_d_as_smoother
use mld_d_diag_solver
use mld_d_ilu_solver
use mld_d_id_solver
use mld_d_gs_solver
#if defined(HAVE_UMF_)
use mld_d_umf_solver
#endif
#if defined(HAVE_SLUDIST_)
use mld_d_sludist_solver
#endif
#if defined(HAVE_SLU_)
use mld_d_slu_solver
#endif
#if defined(HAVE_MUMPS_)
use mld_d_mumps_solver
#endif
implicit none
! Arguments
class(mld_dprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
! Local variables
integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il
character(len=*), parameter :: name='mld_precseti'
info = psb_success_
if (.not.allocated(p%precv)) then
info = 3111
write(psb_err_unit,*) name,&
& ': Error: uninitialized preconditioner,',&
&' should call MLD_PRECINIT'
return
endif
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
if (present(ilmax)) then
ilmax_ = ilmax
else
ilmax_ = ilev_
end if
else
ilev_ = 1
ilmax_ = ilev_
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if ((ilmax_<1).or.(ilmax_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_
return
endif
select case(what)
case (mld_min_coarse_size_)
p%min_coarse_size = max(val,-1)
return
case(mld_max_levs_)
p%max_levs = max(val,1)
return
case(mld_outer_sweeps_)
p%outer_sweeps = max(val,1)
return
end select
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,&
& mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,&
& mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_sub_restr_,mld_sub_prol_, &
& mld_sub_ovr_,mld_sub_fillin_,&
& mld_coarse_mat_)
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
end do
case(mld_coarse_subsolve_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
call p%precv(ilev_)%set(mld_sub_solve_,val,info,pos=pos)
case(mld_coarse_solve_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set(mld_smoother_type_,val,info,pos=pos)
#if defined(HAVE_UMF_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos)
#elif defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_slu_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_mumps_)
#if defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_umf_)
#if defined(HAVE_UMF_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_sludist_)
#if defined(HAVE_SLUDIST_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#elif defined(HAVE_UMF_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_jac_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
end select
endif
case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos)
case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos)
case default
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
end do
end select
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ovr_,mld_sub_fillin_,&
& mld_smoother_sweeps_,mld_smoother_type_)
do ilev_=1,max(1,nlev_-1)
call p%precv(ilev_)%set(what,val,info,pos=pos)
if (info /= 0) return
end do
case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,&
& mld_aggr_eig_,mld_aggr_filter_)
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
case(mld_coarse_mat_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_coarse_mat_,val,info,pos=pos)
end if
case(mld_coarse_solve_)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
#if defined(HAVE_UMF_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos)
#elif defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
case(mld_slu_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_mumps_)
#if defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_umf_)
#if defined(HAVE_UMF_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_sludist_)
#if defined(HAVE_SLUDIST_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#elif defined(HAVE_UMF_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_jac_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
end select
endif
case(mld_coarse_subsolve_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
endif
case(mld_coarse_sweeps_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos)
end if
case(mld_coarse_fillin_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos)
end if
case default
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
end select
endif
end subroutine mld_dprecseti
subroutine mld_dprecsetsm(p,val,info,ilev,ilmax,pos)
use psb_base_mod
@ -639,251 +227,3 @@ subroutine mld_dprecsetag(p,val,info,ilev,ilmax,pos)
end subroutine mld_dprecsetag
!
! Subroutine: mld_dprecsetc
! Version: real
!
! This routine sets the character parameters defining the preconditioner. More
! precisely, the character parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and real parameters, see mld_dprecseti and mld_dprecsetr,
! respectively.
!
!
! Arguments:
! p - type(mld_dprec_type), input/output.
! The preconditioner data structure.
! what - integer, input.
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! string - character(len=*), input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the appropriate levels.
!
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
! of the same parameter at different levels 1,...,nlev-1, even in cases where
! the parameter must have the same value at all the levels but the coarsest one.
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_dprecsetc(p,what,string,info,ilev,ilmax,pos)
use psb_base_mod
use mld_d_prec_mod, mld_protect_name => mld_dprecsetc
implicit none
! Arguments
class(mld_dprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
! Local variables
integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il
character(len=*), parameter :: name='mld_precsetc'
info = psb_success_
if (.not.allocated(p%precv)) then
info = 3111
return
endif
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
else
ilev_ = 1
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
write(psb_err_unit,*) name,&
& ': Error: invalid ILEV/NLEV combination',ilev_, nlev_
info = -1
return
endif
val = mld_stringval(string)
if (val >=0) then
call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos)
else
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
if (present(ilmax)) then
ilmax_ = ilmax
else
ilmax_ = ilev_
end if
else
ilev_ = 1
ilmax_ = ilev_
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if ((ilmax_<1).or.(ilmax_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_
return
endif
do il=ilev_, ilmax_
call p%precv(il)%set(what,string,info,pos=pos)
end do
end if
end subroutine mld_dprecsetc
!
! Subroutine: mld_dprecsetr
! Version: real
!
! This routine sets the real parameters defining the preconditioner. More
! precisely, the real parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and character parameters, see mld_dprecseti and mld_dprecsetc,
! respectively.
!
! Arguments:
! p - type(mld_dprec_type), input/output.
! The preconditioner data structure.
! what - integer, input.
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! val - real(psb_dpk_), input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the appropriate levels.
!
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
! of the same parameter at different levels 1,...,nlev-1, even in cases where
! the parameter must have the same value at all the levels but the coarsest one.
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_dprecsetr(p,what,val,info,ilev,ilmax,pos)
use psb_base_mod
use mld_d_prec_mod, mld_protect_name => mld_dprecsetr
implicit none
! Arguments
class(mld_dprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
! Local variables
integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il
real(psb_dpk_) :: thr
character(len=*), parameter :: name='mld_precsetr'
info = psb_success_
select case(what)
case (mld_min_cr_ratio_)
p%min_cr_ratio = max(done,val)
return
end select
if (.not.allocated(p%precv)) then
write(psb_err_unit,*) name,&
&': Error: uninitialized preconditioner,',&
&' should call MLD_PRECINIT'
info = 3111
return
endif
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
if (present(ilmax)) then
ilmax_ = ilmax
else
ilmax_ = ilev_
end if
else
ilev_ = 1
ilmax_ = ilev_
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if ((ilmax_<1).or.(ilmax_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_
return
endif
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
end do
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate levels
!
select case(what)
case(mld_coarse_iluthrs_)
ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos)
case default
do il=1,nlev_
call p%precv(il)%set(what,val,info,pos=pos)
end do
end select
endif
end subroutine mld_dprecsetr

1
mlprec/impl/mld_s_hierarchy_bld.f90
Unescape Escape View File

@ -444,6 +444,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
iszv = size(prec%precv)
call prec%cmp_complexity()
call prec%cmp_avg_cr()
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&

21
mlprec/impl/mld_scprecset.F90
Unescape Escape View File

@ -75,7 +75,7 @@
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos)
subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use mld_s_prec_mod, mld_protect_name => mld_scprecseti
@ -102,6 +102,7 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local variables
integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il
@ -283,7 +284,7 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos)
case default
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
call p%precv(il)%set(what,val,info,pos=pos,idx=idx)
end do
end select
@ -410,7 +411,7 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos)
case default
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos)
call p%precv(ilev_)%set(what,val,info,pos=pos,idx=idx)
end do
end select
@ -457,7 +458,7 @@ end subroutine mld_scprecseti
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos)
subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
use psb_base_mod
use mld_s_prec_mod, mld_protect_name => mld_scprecsetc
@ -471,6 +472,7 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local variables
integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il
@ -486,7 +488,7 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos)
if (val >=0) then
call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos)
call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos,idx=idx)
else
nlev_ = size(p%precv)
@ -515,7 +517,7 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos)
return
endif
do il=ilev_, ilmax_
call p%precv(il)%set(what,string,info,pos=pos)
call p%precv(il)%set(what,string,info,pos=pos,idx=idx)
end do
end if
@ -560,7 +562,7 @@ end subroutine mld_scprecsetc
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_scprecsetr(p,what,val,info,ilev,ilmax,pos)
subroutine mld_scprecsetr(p,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use mld_s_prec_mod, mld_protect_name => mld_scprecsetr
@ -574,6 +576,7 @@ subroutine mld_scprecsetr(p,what,val,info,ilev,ilmax,pos)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local variables
integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il
@ -634,7 +637,7 @@ subroutine mld_scprecsetr(p,what,val,info,ilev,ilmax,pos)
if (present(ilev)) then
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
call p%precv(il)%set(what,val,info,pos=pos,idx=idx)
end do
else if (.not.present(ilev)) then
@ -650,7 +653,7 @@ subroutine mld_scprecsetr(p,what,val,info,ilev,ilmax,pos)
case default
do il=1,nlev_
call p%precv(il)%set(what,val,info,pos=pos)
call p%precv(il)%set(what,val,info,pos=pos,idx=idx)
end do
end select

1
mlprec/impl/mld_sfile_prec_descr.f90
Unescape Escape View File

@ -172,6 +172,7 @@ subroutine mld_sfile_prec_descr(prec,iout,root)
write(iout_,*) 'Multilevel hierarchy: '
write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',prec%get_complexity()
write(iout_,*) ' Average coarsening : ',prec%get_avg_cr()
ilmin = 2
if (nlev == 2) ilmin=1
do ilev=ilmin,nlev

4
mlprec/impl/mld_sprecinit.F90
Unescape Escape View File

@ -83,7 +83,7 @@
! info - integer, output.
! Error code.
!
subroutine mld_sprecinit(prec,ptype,info)
subroutine mld_sprecinit(ictxt,prec,ptype,info)
use psb_base_mod
use mld_s_prec_mod, mld_protect_name => mld_sprecinit
@ -101,6 +101,7 @@ subroutine mld_sprecinit(prec,ptype,info)
implicit none
! Arguments
integer(psb_ipk_), intent(in) :: ictxt
class(mld_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
@ -117,6 +118,7 @@ subroutine mld_sprecinit(prec,ptype,info)
! Do we want to do something?
endif
endif
prec%ictxt = ictxt
prec%min_coarse_size = -1
select case(psb_toupper(ptype(1:len_trim(ptype))))

627
mlprec/impl/mld_sprecset.F90
Unescape Escape View File

@ -37,385 +37,6 @@
!
! File: mld_sprecset.f90
!
! Subroutine: mld_sprecseti
! Version: real
!
! This routine sets the integer parameters defining the preconditioner. More
! precisely, the integer parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set character and real parameters, see mld_sprecsetc and mld_sprecsetr,
! respectively.
!
!
! Arguments:
! p - type(mld_sprec_type), input/output.
! The preconditioner data structure.
! what - integer, input.
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! val - integer, input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the appropriate levels.
!
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
! of the same parameter at different levels 1,...,nlev-1, even in cases where
! the parameter must have the same value at all the levels but the coarsest one.
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_sprecseti(p,what,val,info,ilev,ilmax,pos)
use psb_base_mod
use mld_s_prec_mod, mld_protect_name => mld_sprecseti
use mld_s_jac_smoother
use mld_s_as_smoother
use mld_s_diag_solver
use mld_s_ilu_solver
use mld_s_id_solver
use mld_s_gs_solver
#if defined(HAVE_SLU_)
use mld_s_slu_solver
#endif
#if defined(HAVE_MUMPS_)
use mld_s_mumps_solver
#endif
implicit none
! Arguments
class(mld_sprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
! Local variables
integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il
character(len=*), parameter :: name='mld_precseti'
info = psb_success_
if (.not.allocated(p%precv)) then
info = 3111
write(psb_err_unit,*) name,&
& ': Error: uninitialized preconditioner,',&
&' should call MLD_PRECINIT'
return
endif
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
if (present(ilmax)) then
ilmax_ = ilmax
else
ilmax_ = ilev_
end if
else
ilev_ = 1
ilmax_ = ilev_
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if ((ilmax_<1).or.(ilmax_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_
return
endif
select case(what)
case (mld_min_coarse_size_)
p%min_coarse_size = max(val,-1)
return
case(mld_max_levs_)
p%max_levs = max(val,1)
return
case(mld_outer_sweeps_)
p%outer_sweeps = max(val,1)
return
end select
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,&
& mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,&
& mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_sub_restr_,mld_sub_prol_, &
& mld_sub_ovr_,mld_sub_fillin_,&
& mld_coarse_mat_)
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
end do
case(mld_coarse_subsolve_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
call p%precv(ilev_)%set(mld_sub_solve_,val,info,pos=pos)
case(mld_coarse_solve_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set(mld_smoother_type_,val,info,pos=pos)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_slu_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_mumps_)
#if defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_umf_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_sludist_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_jac_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
end select
endif
case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos)
case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos)
case default
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
end do
end select
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ovr_,mld_sub_fillin_,&
& mld_smoother_sweeps_,mld_smoother_type_)
do ilev_=1,max(1,nlev_-1)
call p%precv(ilev_)%set(what,val,info,pos=pos)
if (info /= 0) return
end do
case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,&
& mld_aggr_eig_,mld_aggr_filter_)
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
case(mld_coarse_mat_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_coarse_mat_,val,info,pos=pos)
end if
case(mld_coarse_solve_)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
case(mld_slu_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_mumps_)
#if defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_umf_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_sludist_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_jac_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
end select
endif
case(mld_coarse_subsolve_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
endif
case(mld_coarse_sweeps_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos)
end if
case(mld_coarse_fillin_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos)
end if
case default
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
end select
endif
end subroutine mld_sprecseti
subroutine mld_sprecsetsm(p,val,info,ilev,ilmax,pos)
use psb_base_mod
@ -606,251 +227,3 @@ subroutine mld_sprecsetag(p,val,info,ilev,ilmax,pos)
end subroutine mld_sprecsetag
!
! Subroutine: mld_sprecsetc
! Version: real
!
! This routine sets the character parameters defining the preconditioner. More
! precisely, the character parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and real parameters, see mld_sprecseti and mld_sprecsetr,
! respectively.
!
!
! Arguments:
! p - type(mld_sprec_type), input/output.
! The preconditioner data structure.
! what - integer, input.
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! string - character(len=*), input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the appropriate levels.
!
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
! of the same parameter at different levels 1,...,nlev-1, even in cases where
! the parameter must have the same value at all the levels but the coarsest one.
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_sprecsetc(p,what,string,info,ilev,ilmax,pos)
use psb_base_mod
use mld_s_prec_mod, mld_protect_name => mld_sprecsetc
implicit none
! Arguments
class(mld_sprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
! Local variables
integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il
character(len=*), parameter :: name='mld_precsetc'
info = psb_success_
if (.not.allocated(p%precv)) then
info = 3111
return
endif
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
else
ilev_ = 1
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
write(psb_err_unit,*) name,&
& ': Error: invalid ILEV/NLEV combination',ilev_, nlev_
info = -1
return
endif
val = mld_stringval(string)
if (val >=0) then
call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos)
else
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
if (present(ilmax)) then
ilmax_ = ilmax
else
ilmax_ = ilev_
end if
else
ilev_ = 1
ilmax_ = ilev_
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if ((ilmax_<1).or.(ilmax_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_
return
endif
do il=ilev_, ilmax_
call p%precv(il)%set(what,string,info,pos=pos)
end do
end if
end subroutine mld_sprecsetc
!
! Subroutine: mld_sprecsetr
! Version: real
!
! This routine sets the real parameters defining the preconditioner. More
! precisely, the real parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and character parameters, see mld_sprecseti and mld_sprecsetc,
! respectively.
!
! Arguments:
! p - type(mld_sprec_type), input/output.
! The preconditioner data structure.
! what - integer, input.
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! val - real(psb_spk_), input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the appropriate levels.
!
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
! of the same parameter at different levels 1,...,nlev-1, even in cases where
! the parameter must have the same value at all the levels but the coarsest one.
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_sprecsetr(p,what,val,info,ilev,ilmax,pos)
use psb_base_mod
use mld_s_prec_mod, mld_protect_name => mld_sprecsetr
implicit none
! Arguments
class(mld_sprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
! Local variables
integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il
real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precsetr'
info = psb_success_
select case(what)
case (mld_min_cr_ratio_)
p%min_cr_ratio = max(sone,val)
return
end select
if (.not.allocated(p%precv)) then
write(psb_err_unit,*) name,&
&': Error: uninitialized preconditioner,',&
&' should call MLD_PRECINIT'
info = 3111
return
endif
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
if (present(ilmax)) then
ilmax_ = ilmax
else
ilmax_ = ilev_
end if
else
ilev_ = 1
ilmax_ = ilev_
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if ((ilmax_<1).or.(ilmax_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_
return
endif
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
end do
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate levels
!
select case(what)
case(mld_coarse_iluthrs_)
ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos)
case default
do il=1,nlev_
call p%precv(il)%set(what,val,info,pos=pos)
end do
end select
endif
end subroutine mld_sprecsetr

1
mlprec/impl/mld_z_hierarchy_bld.f90
Unescape Escape View File

@ -444,6 +444,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
iszv = size(prec%precv)
call prec%cmp_complexity()
call prec%cmp_avg_cr()
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&

21
mlprec/impl/mld_zcprecset.F90
Unescape Escape View File

@ -75,7 +75,7 @@
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos)
subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use mld_z_prec_mod, mld_protect_name => mld_zcprecseti
@ -108,6 +108,7 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local variables
integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il
@ -303,7 +304,7 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos)
case default
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
call p%precv(il)%set(what,val,info,pos=pos,idx=idx)
end do
end select
@ -444,7 +445,7 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos)
case default
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos)
call p%precv(ilev_)%set(what,val,info,pos=pos,idx=idx)
end do
end select
@ -491,7 +492,7 @@ end subroutine mld_zcprecseti
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos)
subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
use psb_base_mod
use mld_z_prec_mod, mld_protect_name => mld_zcprecsetc
@ -505,6 +506,7 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local variables
integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il
@ -520,7 +522,7 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos)
if (val >=0) then
call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos)
call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos,idx=idx)
else
nlev_ = size(p%precv)
@ -549,7 +551,7 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos)
return
endif
do il=ilev_, ilmax_
call p%precv(il)%set(what,string,info,pos=pos)
call p%precv(il)%set(what,string,info,pos=pos,idx=idx)
end do
end if
@ -594,7 +596,7 @@ end subroutine mld_zcprecsetc
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_zcprecsetr(p,what,val,info,ilev,ilmax,pos)
subroutine mld_zcprecsetr(p,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use mld_z_prec_mod, mld_protect_name => mld_zcprecsetr
@ -608,6 +610,7 @@ subroutine mld_zcprecsetr(p,what,val,info,ilev,ilmax,pos)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local variables
integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il
@ -668,7 +671,7 @@ subroutine mld_zcprecsetr(p,what,val,info,ilev,ilmax,pos)
if (present(ilev)) then
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
call p%precv(il)%set(what,val,info,pos=pos,idx=idx)
end do
else if (.not.present(ilev)) then
@ -684,7 +687,7 @@ subroutine mld_zcprecsetr(p,what,val,info,ilev,ilmax,pos)
case default
do il=1,nlev_
call p%precv(il)%set(what,val,info,pos=pos)
call p%precv(il)%set(what,val,info,pos=pos,idx=idx)
end do
end select

1
mlprec/impl/mld_zfile_prec_descr.f90
Unescape Escape View File

@ -172,6 +172,7 @@ subroutine mld_zfile_prec_descr(prec,iout,root)
write(iout_,*) 'Multilevel hierarchy: '
write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',prec%get_complexity()
write(iout_,*) ' Average coarsening : ',prec%get_avg_cr()
ilmin = 2
if (nlev == 2) ilmin=1
do ilev=ilmin,nlev

4
mlprec/impl/mld_zprecinit.F90
Unescape Escape View File

@ -83,7 +83,7 @@
! info - integer, output.
! Error code.
!
subroutine mld_zprecinit(prec,ptype,info)
subroutine mld_zprecinit(ictxt,prec,ptype,info)
use psb_base_mod
use mld_z_prec_mod, mld_protect_name => mld_zprecinit
@ -104,6 +104,7 @@ subroutine mld_zprecinit(prec,ptype,info)
implicit none
! Arguments
integer(psb_ipk_), intent(in) :: ictxt
class(mld_zprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
@ -120,6 +121,7 @@ subroutine mld_zprecinit(prec,ptype,info)
! Do we want to do something?
endif
endif
prec%ictxt = ictxt
prec%min_coarse_size = -1
select case(psb_toupper(ptype(1:len_trim(ptype))))

660
mlprec/impl/mld_zprecset.F90
Unescape Escape View File

@ -37,418 +37,6 @@
!
! File: mld_zprecset.f90
!
! Subroutine: mld_zprecseti
! Version: complex
!
! This routine sets the integer parameters defining the preconditioner. More
! precisely, the integer parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set character and complex parameters, see mld_zprecsetc and mld_zprecsetr,
! respectively.
!
!
! Arguments:
! p - type(mld_zprec_type), input/output.
! The preconditioner data structure.
! what - integer, input.
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! val - integer, input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the appropriate levels.
!
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
! of the same parameter at different levels 1,...,nlev-1, even in cases where
! the parameter must have the same value at all the levels but the coarsest one.
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_zprecseti(p,what,val,info,ilev,ilmax,pos)
use psb_base_mod
use mld_z_prec_mod, mld_protect_name => mld_zprecseti
use mld_z_jac_smoother
use mld_z_as_smoother
use mld_z_diag_solver
use mld_z_ilu_solver
use mld_z_id_solver
use mld_z_gs_solver
#if defined(HAVE_UMF_)
use mld_z_umf_solver
#endif
#if defined(HAVE_SLUDIST_)
use mld_z_sludist_solver
#endif
#if defined(HAVE_SLU_)
use mld_z_slu_solver
#endif
#if defined(HAVE_MUMPS_)
use mld_z_mumps_solver
#endif
implicit none
! Arguments
class(mld_zprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
! Local variables
integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il
character(len=*), parameter :: name='mld_precseti'
info = psb_success_
if (.not.allocated(p%precv)) then
info = 3111
write(psb_err_unit,*) name,&
& ': Error: uninitialized preconditioner,',&
&' should call MLD_PRECINIT'
return
endif
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
if (present(ilmax)) then
ilmax_ = ilmax
else
ilmax_ = ilev_
end if
else
ilev_ = 1
ilmax_ = ilev_
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if ((ilmax_<1).or.(ilmax_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_
return
endif
select case(what)
case (mld_min_coarse_size_)
p%min_coarse_size = max(val,-1)
return
case(mld_max_levs_)
p%max_levs = max(val,1)
return
case(mld_outer_sweeps_)
p%outer_sweeps = max(val,1)
return
end select
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,&
& mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,&
& mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_sub_restr_,mld_sub_prol_, &
& mld_sub_ovr_,mld_sub_fillin_,&
& mld_coarse_mat_)
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
end do
case(mld_coarse_subsolve_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
call p%precv(ilev_)%set(mld_sub_solve_,val,info,pos=pos)
case(mld_coarse_solve_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set(mld_smoother_type_,val,info,pos=pos)
#if defined(HAVE_UMF_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos)
#elif defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_slu_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_mumps_)
#if defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_umf_)
#if defined(HAVE_UMF_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_sludist_)
#if defined(HAVE_SLUDIST_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#elif defined(HAVE_UMF_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_jac_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
end select
endif
case(mld_coarse_sweeps_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos)
case(mld_coarse_fillin_)
if (ilev_ /= nlev_) then
write(psb_err_unit,*) name,&
& ': Error: Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos)
case default
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
end do
end select
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ovr_,mld_sub_fillin_,&
& mld_smoother_sweeps_,mld_smoother_type_)
do ilev_=1,max(1,nlev_-1)
call p%precv(ilev_)%set(what,val,info,pos=pos)
if (info /= 0) return
end do
case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,&
& mld_aggr_eig_,mld_aggr_filter_)
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
case(mld_coarse_mat_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_coarse_mat_,val,info,pos=pos)
end if
case(mld_coarse_solve_)
if (nlev_ > 1) then
call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos)
select case (val)
case(mld_bjac_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
#if defined(HAVE_UMF_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos)
#elif defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
case(mld_slu_)
#if defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_mumps_)
#if defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_umf_)
#if defined(HAVE_UMF_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_sludist_)
#if defined(HAVE_SLUDIST_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#elif defined(HAVE_UMF_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_SLU_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
#elif defined(HAVE_MUMPS_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#else
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
#endif
case(mld_jac_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
end select
endif
case(mld_coarse_subsolve_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
endif
case(mld_coarse_sweeps_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos)
end if
case(mld_coarse_fillin_)
if (nlev_ > 1) then
call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos)
end if
case default
do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos)
end do
end select
endif
end subroutine mld_zprecseti
subroutine mld_zprecsetsm(p,val,info,ilev,ilmax,pos)
use psb_base_mod
@ -639,251 +227,3 @@ subroutine mld_zprecsetag(p,val,info,ilev,ilmax,pos)
end subroutine mld_zprecsetag
!
! Subroutine: mld_zprecsetc
! Version: complex
!
! This routine sets the character parameters defining the preconditioner. More
! precisely, the character parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and complex parameters, see mld_zprecseti and mld_zprecsetr,
! respectively.
!
!
! Arguments:
! p - type(mld_zprec_type), input/output.
! The preconditioner data structure.
! what - integer, input.
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! string - character(len=*), input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the appropriate levels.
!
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
! of the same parameter at different levels 1,...,nlev-1, even in cases where
! the parameter must have the same value at all the levels but the coarsest one.
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_zprecsetc(p,what,string,info,ilev,ilmax,pos)
use psb_base_mod
use mld_z_prec_mod, mld_protect_name => mld_zprecsetc
implicit none
! Arguments
class(mld_zprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
! Local variables
integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il
character(len=*), parameter :: name='mld_precsetc'
info = psb_success_
if (.not.allocated(p%precv)) then
info = 3111
return
endif
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
else
ilev_ = 1
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
write(psb_err_unit,*) name,&
& ': Error: invalid ILEV/NLEV combination',ilev_, nlev_
info = -1
return
endif
val = mld_stringval(string)
if (val >=0) then
call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos)
else
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
if (present(ilmax)) then
ilmax_ = ilmax
else
ilmax_ = ilev_
end if
else
ilev_ = 1
ilmax_ = ilev_
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if ((ilmax_<1).or.(ilmax_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_
return
endif
do il=ilev_, ilmax_
call p%precv(il)%set(what,string,info,pos=pos)
end do
end if
end subroutine mld_zprecsetc
!
! Subroutine: mld_zprecsetr
! Version: complex
!
! This routine sets the complex parameters defining the preconditioner. More
! precisely, the complex parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and character parameters, see mld_zprecseti and mld_zprecsetc,
! respectively.
!
! Arguments:
! p - type(mld_zprec_type), input/output.
! The preconditioner data structure.
! what - integer, input.
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! val - real(psb_dpk_), input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the appropriate levels.
!
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
! of the same parameter at different levels 1,...,nlev-1, even in cases where
! the parameter must have the same value at all the levels but the coarsest one.
! For this reason, the interface mld_precset to this routine has been built in
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
!
subroutine mld_zprecsetr(p,what,val,info,ilev,ilmax,pos)
use psb_base_mod
use mld_z_prec_mod, mld_protect_name => mld_zprecsetr
implicit none
! Arguments
class(mld_zprec_type), intent(inout) :: p
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax
character(len=*), optional, intent(in) :: pos
! Local variables
integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il
real(psb_dpk_) :: thr
character(len=*), parameter :: name='mld_precsetr'
info = psb_success_
select case(what)
case (mld_min_cr_ratio_)
p%min_cr_ratio = max(done,val)
return
end select
if (.not.allocated(p%precv)) then
write(psb_err_unit,*) name,&
&': Error: uninitialized preconditioner,',&
&' should call MLD_PRECINIT'
info = 3111
return
endif
nlev_ = size(p%precv)
if (present(ilev)) then
ilev_ = ilev
if (present(ilmax)) then
ilmax_ = ilmax
else
ilmax_ = ilev_
end if
else
ilev_ = 1
ilmax_ = ilev_
end if
if ((ilev_<1).or.(ilev_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
return
endif
if ((ilmax_<1).or.(ilmax_ > nlev_)) then
info = -1
write(psb_err_unit,*) name,&
&': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_
return
endif
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
do il=ilev_, ilmax_
call p%precv(il)%set(what,val,info,pos=pos)
end do
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate levels
!
select case(what)
case(mld_coarse_iluthrs_)
ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos)
case default
do il=1,nlev_
call p%precv(il)%set(what,val,info,pos=pos)
end do
end select
endif
end subroutine mld_zprecsetr

25
mlprec/impl/smoother/Makefile
Unescape Escape View File

@ -18,9 +18,6 @@ mld_c_as_smoother_cseti.o \
mld_c_as_smoother_csetr.o \
mld_c_as_smoother_dmp.o \
mld_c_as_smoother_free.o \
mld_c_as_smoother_setc.o \
mld_c_as_smoother_seti.o \
mld_c_as_smoother_setr.o \
mld_c_as_smoother_prol_a.o \
mld_c_as_smoother_prol_v.o \
mld_c_as_smoother_restr_a.o \
@ -37,9 +34,6 @@ mld_c_base_smoother_csetr.o \
mld_c_base_smoother_descr.o \
mld_c_base_smoother_dmp.o \
mld_c_base_smoother_free.o \
mld_c_base_smoother_setc.o \
mld_c_base_smoother_seti.o \
mld_c_base_smoother_setr.o \
mld_c_jac_smoother_apply.o \
mld_c_jac_smoother_apply_vect.o \
mld_c_jac_smoother_bld.o \
@ -58,9 +52,6 @@ mld_d_as_smoother_cseti.o \
mld_d_as_smoother_csetr.o \
mld_d_as_smoother_dmp.o \
mld_d_as_smoother_free.o \
mld_d_as_smoother_setc.o \
mld_d_as_smoother_seti.o \
mld_d_as_smoother_setr.o \
mld_d_as_smoother_prol_a.o \
mld_d_as_smoother_prol_v.o \
mld_d_as_smoother_restr_a.o \
@ -77,9 +68,6 @@ mld_d_base_smoother_csetr.o \
mld_d_base_smoother_descr.o \
mld_d_base_smoother_dmp.o \
mld_d_base_smoother_free.o \
mld_d_base_smoother_setc.o \
mld_d_base_smoother_seti.o \
mld_d_base_smoother_setr.o \
mld_d_jac_smoother_apply.o \
mld_d_jac_smoother_apply_vect.o \
mld_d_jac_smoother_bld.o \
@ -98,9 +86,6 @@ mld_s_as_smoother_cseti.o \
mld_s_as_smoother_csetr.o \
mld_s_as_smoother_dmp.o \
mld_s_as_smoother_free.o \
mld_s_as_smoother_setc.o \
mld_s_as_smoother_seti.o \
mld_s_as_smoother_setr.o \
mld_s_as_smoother_prol_a.o \
mld_s_as_smoother_prol_v.o \
mld_s_as_smoother_restr_a.o \
@ -117,9 +102,6 @@ mld_s_base_smoother_csetr.o \
mld_s_base_smoother_descr.o \
mld_s_base_smoother_dmp.o \
mld_s_base_smoother_free.o \
mld_s_base_smoother_setc.o \
mld_s_base_smoother_seti.o \
mld_s_base_smoother_setr.o \
mld_s_jac_smoother_apply.o \
mld_s_jac_smoother_apply_vect.o \
mld_s_jac_smoother_bld.o \
@ -138,9 +120,6 @@ mld_z_as_smoother_cseti.o \
mld_z_as_smoother_csetr.o \
mld_z_as_smoother_dmp.o \
mld_z_as_smoother_free.o \
mld_z_as_smoother_setc.o \
mld_z_as_smoother_seti.o \
mld_z_as_smoother_setr.o \
mld_z_as_smoother_prol_a.o \
mld_z_as_smoother_prol_v.o \
mld_z_as_smoother_restr_a.o \
@ -157,9 +136,6 @@ mld_z_base_smoother_csetr.o \
mld_z_base_smoother_descr.o \
mld_z_base_smoother_dmp.o \
mld_z_base_smoother_free.o \
mld_z_base_smoother_setc.o \
mld_z_base_smoother_seti.o \
mld_z_base_smoother_setr.o \
mld_z_jac_smoother_apply.o \
mld_z_jac_smoother_apply_vect.o \
mld_z_jac_smoother_bld.o \
@ -168,7 +144,6 @@ mld_z_jac_smoother_dmp.o \
mld_z_jac_smoother_clone.o \
mld_z_jac_smoother_cnv.o
LIBNAME=libmld_prec.a
lib: $(OBJS)

7
mlprec/impl/smoother/mld_c_as_smoother_csetc.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_as_smoother_csetc(sm,what,val,info)
subroutine mld_c_as_smoother_csetc(sm,what,val,info,idx)
use psb_base_mod
use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_csetc
@ -45,6 +45,7 @@ subroutine mld_c_as_smoother_csetc(sm,what,val,info)
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='c_as_smoother_csetc'
@ -54,9 +55,9 @@ subroutine mld_c_as_smoother_csetc(sm,what,val,info)
ival = sm%stringval(val)
if (ival >= 0) then
call sm%set(what,ival,info)
call sm%set(what,ival,info,idx=idx)
else
call sm%mld_c_base_smoother_type%set(what,val,info)
call sm%mld_c_base_smoother_type%set(what,val,info,idx=idx)
end if
if (info /= psb_success_) then

5
mlprec/impl/smoother/mld_c_as_smoother_cseti.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_as_smoother_cseti(sm,what,val,info)
subroutine mld_c_as_smoother_cseti(sm,what,val,info,idx)
use psb_base_mod
use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_cseti
@ -46,6 +46,7 @@ subroutine mld_c_as_smoother_cseti(sm,what,val,info)
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_as_smoother_cseti'
@ -60,7 +61,7 @@ subroutine mld_c_as_smoother_cseti(sm,what,val,info)
case('SUB_PROL')
sm%prol = val
case default
call sm%mld_c_base_smoother_type%set(what,val,info)
call sm%mld_c_base_smoother_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)

5
mlprec/impl/smoother/mld_c_as_smoother_csetr.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_as_smoother_csetr(sm,what,val,info)
subroutine mld_c_as_smoother_csetr(sm,what,val,info,idx)
use psb_base_mod
use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_csetr
@ -45,6 +45,7 @@ subroutine mld_c_as_smoother_csetr(sm,what,val,info)
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_as_smoother_csetr'
@ -53,7 +54,7 @@ subroutine mld_c_as_smoother_csetr(sm,what,val,info)
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
call sm%sv%set(what,val,info,idx=idx)
else
!!$ write(0,*) trim(name),' Missing component, not setting!'
!!$ info = 1121

74
mlprec/impl/smoother/mld_c_as_smoother_setc.f90
Unescape Escape View File

@ -1,74 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_as_smoother_setc(sm,what,val,info)
use psb_base_mod
use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_setc
Implicit None
! Arguments
class(mld_c_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='c_as_smoother_setc'
info = psb_success_
call psb_erractionsave(err_act)
ival = sm%stringval(val)
if (ival >= 0) then
call sm%set(what,ival,info)
else
call sm%mld_c_base_smoother_type%set(what,val,info)
end if
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info, name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_c_as_smoother_setc

72
mlprec/impl/smoother/mld_c_as_smoother_seti.f90
Unescape Escape View File

@ -1,72 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_as_smoother_seti(sm,what,val,info)
use psb_base_mod
use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_seti
Implicit None
! Arguments
class(mld_c_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_as_smoother_seti'
info = psb_success_
call psb_erractionsave(err_act)
select case(what)
case(mld_sub_ovr_)
sm%novr = val
case(mld_sub_restr_)
sm%restr = val
case(mld_sub_prol_)
sm%prol = val
case default
call sm%mld_c_base_smoother_type%set(what,val,info)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_c_as_smoother_seti

68
mlprec/impl/smoother/mld_c_as_smoother_setr.f90
Unescape Escape View File

@ -1,68 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_as_smoother_setr(sm,what,val,info)
use psb_base_mod
use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_setr
Implicit None
! Arguments
class(mld_c_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_as_smoother_setr'
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
else
!!$ write(0,*) trim(name),' Missing component, not setting!'
!!$ info = 1121
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_c_as_smoother_setr

7
mlprec/impl/smoother/mld_c_base_smoother_csetc.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_smoother_csetc(sm,what,val,info)
subroutine mld_c_base_smoother_csetc(sm,what,val,info,idx)
use psb_base_mod
use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_csetc
@ -46,6 +46,7 @@ subroutine mld_c_base_smoother_csetc(sm,what,val,info)
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='c_base_smoother_csetc'
@ -55,10 +56,10 @@ subroutine mld_c_base_smoother_csetc(sm,what,val,info)
ival = sm%stringval(val)
if (ival >= 0) then
call sm%set(what,ival,info)
call sm%set(what,ival,info,idx=idx)
else
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
call sm%sv%set(what,val,info,idx=idx)
end if
end if

5
mlprec/impl/smoother/mld_c_base_smoother_cseti.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_smoother_cseti(sm,what,val,info)
subroutine mld_c_base_smoother_cseti(sm,what,val,info,idx)
use psb_base_mod
use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_cseti
@ -45,6 +45,7 @@ subroutine mld_c_base_smoother_cseti(sm,what,val,info)
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_base_smoother_cseti'
@ -52,7 +53,7 @@ subroutine mld_c_base_smoother_cseti(sm,what,val,info)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
call sm%sv%set(what,val,info,idx=idx)
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)

5
mlprec/impl/smoother/mld_c_base_smoother_csetr.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_smoother_csetr(sm,what,val,info)
subroutine mld_c_base_smoother_csetr(sm,what,val,info,idx)
use psb_base_mod
use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_csetr
@ -46,6 +46,7 @@ subroutine mld_c_base_smoother_csetr(sm,what,val,info)
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_base_smoother_csetr'
@ -55,7 +56,7 @@ subroutine mld_c_base_smoother_csetr(sm,what,val,info)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
call sm%sv%set(what,val,info,idx=idx)
end if
if (info /= psb_success_) goto 9999

73
mlprec/impl/smoother/mld_c_base_smoother_setc.f90
Unescape Escape View File

@ -1,73 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_smoother_setc(sm,what,val,info)
use psb_base_mod
use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_setc
Implicit None
! Arguments
class(mld_c_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='c_base_smoother_setc'
call psb_erractionsave(err_act)
info = psb_success_
ival = sm%stringval(val)
if (ival >= 0) then
call sm%set(what,ival,info)
else
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
end if
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_c_base_smoother_setc

64
mlprec/impl/smoother/mld_c_base_smoother_seti.f90
Unescape Escape View File

@ -1,64 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_smoother_seti(sm,what,val,info)
use psb_base_mod
use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_seti
Implicit None
! Arguments
class(mld_c_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_base_smoother_seti'
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_c_base_smoother_seti

68
mlprec/impl/smoother/mld_c_base_smoother_setr.f90
Unescape Escape View File

@ -1,68 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_c_base_smoother_setr(sm,what,val,info)
use psb_base_mod
use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_setr
Implicit None
! Arguments
class(mld_c_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_base_smoother_setr'
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_c_base_smoother_setr

7
mlprec/impl/smoother/mld_d_as_smoother_csetc.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_as_smoother_csetc(sm,what,val,info)
subroutine mld_d_as_smoother_csetc(sm,what,val,info,idx)
use psb_base_mod
use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_csetc
@ -45,6 +45,7 @@ subroutine mld_d_as_smoother_csetc(sm,what,val,info)
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='d_as_smoother_csetc'
@ -54,9 +55,9 @@ subroutine mld_d_as_smoother_csetc(sm,what,val,info)
ival = sm%stringval(val)
if (ival >= 0) then
call sm%set(what,ival,info)
call sm%set(what,ival,info,idx=idx)
else
call sm%mld_d_base_smoother_type%set(what,val,info)
call sm%mld_d_base_smoother_type%set(what,val,info,idx=idx)
end if
if (info /= psb_success_) then

5
mlprec/impl/smoother/mld_d_as_smoother_cseti.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_as_smoother_cseti(sm,what,val,info)
subroutine mld_d_as_smoother_cseti(sm,what,val,info,idx)
use psb_base_mod
use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_cseti
@ -46,6 +46,7 @@ subroutine mld_d_as_smoother_cseti(sm,what,val,info)
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_as_smoother_cseti'
@ -60,7 +61,7 @@ subroutine mld_d_as_smoother_cseti(sm,what,val,info)
case('SUB_PROL')
sm%prol = val
case default
call sm%mld_d_base_smoother_type%set(what,val,info)
call sm%mld_d_base_smoother_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)

5
mlprec/impl/smoother/mld_d_as_smoother_csetr.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_as_smoother_csetr(sm,what,val,info)
subroutine mld_d_as_smoother_csetr(sm,what,val,info,idx)
use psb_base_mod
use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_csetr
@ -45,6 +45,7 @@ subroutine mld_d_as_smoother_csetr(sm,what,val,info)
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_as_smoother_csetr'
@ -53,7 +54,7 @@ subroutine mld_d_as_smoother_csetr(sm,what,val,info)
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
call sm%sv%set(what,val,info,idx=idx)
else
!!$ write(0,*) trim(name),' Missing component, not setting!'
!!$ info = 1121

74
mlprec/impl/smoother/mld_d_as_smoother_setc.f90
Unescape Escape View File

@ -1,74 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_as_smoother_setc(sm,what,val,info)
use psb_base_mod
use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_setc
Implicit None
! Arguments
class(mld_d_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='d_as_smoother_setc'
info = psb_success_
call psb_erractionsave(err_act)
ival = sm%stringval(val)
if (ival >= 0) then
call sm%set(what,ival,info)
else
call sm%mld_d_base_smoother_type%set(what,val,info)
end if
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info, name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_d_as_smoother_setc

72
mlprec/impl/smoother/mld_d_as_smoother_seti.f90
Unescape Escape View File

@ -1,72 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_as_smoother_seti(sm,what,val,info)
use psb_base_mod
use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_seti
Implicit None
! Arguments
class(mld_d_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_as_smoother_seti'
info = psb_success_
call psb_erractionsave(err_act)
select case(what)
case(mld_sub_ovr_)
sm%novr = val
case(mld_sub_restr_)
sm%restr = val
case(mld_sub_prol_)
sm%prol = val
case default
call sm%mld_d_base_smoother_type%set(what,val,info)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_d_as_smoother_seti

68
mlprec/impl/smoother/mld_d_as_smoother_setr.f90
Unescape Escape View File

@ -1,68 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_as_smoother_setr(sm,what,val,info)
use psb_base_mod
use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_setr
Implicit None
! Arguments
class(mld_d_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_as_smoother_setr'
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
else
!!$ write(0,*) trim(name),' Missing component, not setting!'
!!$ info = 1121
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_d_as_smoother_setr

7
mlprec/impl/smoother/mld_d_base_smoother_csetc.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_smoother_csetc(sm,what,val,info)
subroutine mld_d_base_smoother_csetc(sm,what,val,info,idx)
use psb_base_mod
use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_csetc
@ -46,6 +46,7 @@ subroutine mld_d_base_smoother_csetc(sm,what,val,info)
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_smoother_csetc'
@ -55,10 +56,10 @@ subroutine mld_d_base_smoother_csetc(sm,what,val,info)
ival = sm%stringval(val)
if (ival >= 0) then
call sm%set(what,ival,info)
call sm%set(what,ival,info,idx=idx)
else
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
call sm%sv%set(what,val,info,idx=idx)
end if
end if

5
mlprec/impl/smoother/mld_d_base_smoother_cseti.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_smoother_cseti(sm,what,val,info)
subroutine mld_d_base_smoother_cseti(sm,what,val,info,idx)
use psb_base_mod
use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_cseti
@ -45,6 +45,7 @@ subroutine mld_d_base_smoother_cseti(sm,what,val,info)
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_smoother_cseti'
@ -52,7 +53,7 @@ subroutine mld_d_base_smoother_cseti(sm,what,val,info)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
call sm%sv%set(what,val,info,idx=idx)
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)

5
mlprec/impl/smoother/mld_d_base_smoother_csetr.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_smoother_csetr(sm,what,val,info)
subroutine mld_d_base_smoother_csetr(sm,what,val,info,idx)
use psb_base_mod
use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_csetr
@ -46,6 +46,7 @@ subroutine mld_d_base_smoother_csetr(sm,what,val,info)
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_smoother_csetr'
@ -55,7 +56,7 @@ subroutine mld_d_base_smoother_csetr(sm,what,val,info)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
call sm%sv%set(what,val,info,idx=idx)
end if
if (info /= psb_success_) goto 9999

73
mlprec/impl/smoother/mld_d_base_smoother_setc.f90
Unescape Escape View File

@ -1,73 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_smoother_setc(sm,what,val,info)
use psb_base_mod
use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_setc
Implicit None
! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_smoother_setc'
call psb_erractionsave(err_act)
info = psb_success_
ival = sm%stringval(val)
if (ival >= 0) then
call sm%set(what,ival,info)
else
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
end if
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_d_base_smoother_setc

64
mlprec/impl/smoother/mld_d_base_smoother_seti.f90
Unescape Escape View File

@ -1,64 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_smoother_seti(sm,what,val,info)
use psb_base_mod
use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_seti
Implicit None
! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_smoother_seti'
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_d_base_smoother_seti

68
mlprec/impl/smoother/mld_d_base_smoother_setr.f90
Unescape Escape View File

@ -1,68 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_d_base_smoother_setr(sm,what,val,info)
use psb_base_mod
use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_setr
Implicit None
! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_smoother_setr'
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_d_base_smoother_setr

7
mlprec/impl/smoother/mld_s_as_smoother_csetc.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_as_smoother_csetc(sm,what,val,info)
subroutine mld_s_as_smoother_csetc(sm,what,val,info,idx)
use psb_base_mod
use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_csetc
@ -45,6 +45,7 @@ subroutine mld_s_as_smoother_csetc(sm,what,val,info)
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='s_as_smoother_csetc'
@ -54,9 +55,9 @@ subroutine mld_s_as_smoother_csetc(sm,what,val,info)
ival = sm%stringval(val)
if (ival >= 0) then
call sm%set(what,ival,info)
call sm%set(what,ival,info,idx=idx)
else
call sm%mld_s_base_smoother_type%set(what,val,info)
call sm%mld_s_base_smoother_type%set(what,val,info,idx=idx)
end if
if (info /= psb_success_) then

5
mlprec/impl/smoother/mld_s_as_smoother_cseti.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_as_smoother_cseti(sm,what,val,info)
subroutine mld_s_as_smoother_cseti(sm,what,val,info,idx)
use psb_base_mod
use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_cseti
@ -46,6 +46,7 @@ subroutine mld_s_as_smoother_cseti(sm,what,val,info)
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_as_smoother_cseti'
@ -60,7 +61,7 @@ subroutine mld_s_as_smoother_cseti(sm,what,val,info)
case('SUB_PROL')
sm%prol = val
case default
call sm%mld_s_base_smoother_type%set(what,val,info)
call sm%mld_s_base_smoother_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)

5
mlprec/impl/smoother/mld_s_as_smoother_csetr.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_as_smoother_csetr(sm,what,val,info)
subroutine mld_s_as_smoother_csetr(sm,what,val,info,idx)
use psb_base_mod
use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_csetr
@ -45,6 +45,7 @@ subroutine mld_s_as_smoother_csetr(sm,what,val,info)
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_as_smoother_csetr'
@ -53,7 +54,7 @@ subroutine mld_s_as_smoother_csetr(sm,what,val,info)
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
call sm%sv%set(what,val,info,idx=idx)
else
!!$ write(0,*) trim(name),' Missing component, not setting!'
!!$ info = 1121

74
mlprec/impl/smoother/mld_s_as_smoother_setc.f90
Unescape Escape View File

@ -1,74 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_as_smoother_setc(sm,what,val,info)
use psb_base_mod
use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_setc
Implicit None
! Arguments
class(mld_s_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='s_as_smoother_setc'
info = psb_success_
call psb_erractionsave(err_act)
ival = sm%stringval(val)
if (ival >= 0) then
call sm%set(what,ival,info)
else
call sm%mld_s_base_smoother_type%set(what,val,info)
end if
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info, name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_s_as_smoother_setc

72
mlprec/impl/smoother/mld_s_as_smoother_seti.f90
Unescape Escape View File

@ -1,72 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_as_smoother_seti(sm,what,val,info)
use psb_base_mod
use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_seti
Implicit None
! Arguments
class(mld_s_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_as_smoother_seti'
info = psb_success_
call psb_erractionsave(err_act)
select case(what)
case(mld_sub_ovr_)
sm%novr = val
case(mld_sub_restr_)
sm%restr = val
case(mld_sub_prol_)
sm%prol = val
case default
call sm%mld_s_base_smoother_type%set(what,val,info)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_s_as_smoother_seti

68
mlprec/impl/smoother/mld_s_as_smoother_setr.f90
Unescape Escape View File

@ -1,68 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_as_smoother_setr(sm,what,val,info)
use psb_base_mod
use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_setr
Implicit None
! Arguments
class(mld_s_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_as_smoother_setr'
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
else
!!$ write(0,*) trim(name),' Missing component, not setting!'
!!$ info = 1121
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_s_as_smoother_setr

7
mlprec/impl/smoother/mld_s_base_smoother_csetc.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_base_smoother_csetc(sm,what,val,info)
subroutine mld_s_base_smoother_csetc(sm,what,val,info,idx)
use psb_base_mod
use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_csetc
@ -46,6 +46,7 @@ subroutine mld_s_base_smoother_csetc(sm,what,val,info)
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='s_base_smoother_csetc'
@ -55,10 +56,10 @@ subroutine mld_s_base_smoother_csetc(sm,what,val,info)
ival = sm%stringval(val)
if (ival >= 0) then
call sm%set(what,ival,info)
call sm%set(what,ival,info,idx=idx)
else
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
call sm%sv%set(what,val,info,idx=idx)
end if
end if

5
mlprec/impl/smoother/mld_s_base_smoother_cseti.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_base_smoother_cseti(sm,what,val,info)
subroutine mld_s_base_smoother_cseti(sm,what,val,info,idx)
use psb_base_mod
use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_cseti
@ -45,6 +45,7 @@ subroutine mld_s_base_smoother_cseti(sm,what,val,info)
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_base_smoother_cseti'
@ -52,7 +53,7 @@ subroutine mld_s_base_smoother_cseti(sm,what,val,info)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
call sm%sv%set(what,val,info,idx=idx)
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)

5
mlprec/impl/smoother/mld_s_base_smoother_csetr.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_base_smoother_csetr(sm,what,val,info)
subroutine mld_s_base_smoother_csetr(sm,what,val,info,idx)
use psb_base_mod
use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_csetr
@ -46,6 +46,7 @@ subroutine mld_s_base_smoother_csetr(sm,what,val,info)
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_base_smoother_csetr'
@ -55,7 +56,7 @@ subroutine mld_s_base_smoother_csetr(sm,what,val,info)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
call sm%sv%set(what,val,info,idx=idx)
end if
if (info /= psb_success_) goto 9999

73
mlprec/impl/smoother/mld_s_base_smoother_setc.f90
Unescape Escape View File

@ -1,73 +0,0 @@
!
!
! MLD2P4 version 2.2
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2008-2018
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the MLD2P4 group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine mld_s_base_smoother_setc(sm,what,val,info)
use psb_base_mod
use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_setc
Implicit None
! Arguments
class(mld_s_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='s_base_smoother_setc'
call psb_erractionsave(err_act)
info = psb_success_
ival = sm%stringval(val)
if (ival >= 0) then
call sm%set(what,ival,info)
else
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
end if
end if
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine mld_s_base_smoother_setc

Some files were not shown because too many files have changed in this diff Show More

Write Preview
Loading…
Cancel
Save