mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 22:55:12 +00:00
mld2p4-2:
Changelog config/pac.m4 configure.ac configure examples/fileread/Makefile examples/pdegen/Makefile mlprec/impl/Makefile mlprec/impl/level/Makefile mlprec/impl/mld_c_dec_map_bld.f90 mlprec/impl/mld_c_hierarchy_bld.f90 mlprec/impl/mld_c_lev_aggrmap_bld.f90 mlprec/impl/mld_c_lev_aggrmat_asb.f90 mlprec/impl/mld_c_smoothers_bld.f90 mlprec/impl/mld_caggrmap_bld.f90 mlprec/impl/mld_caggrmat_asb.f90 mlprec/impl/mld_caggrmat_biz_asb.f90 mlprec/impl/mld_caggrmat_minnrg_asb.f90 mlprec/impl/mld_caggrmat_nosmth_asb.f90 mlprec/impl/mld_caggrmat_smth_asb.f90 mlprec/impl/mld_cmlprec_aply.f90 mlprec/impl/mld_cmlprec_bld.f90 mlprec/impl/mld_cprecaply.f90 mlprec/impl/mld_cprecbld.f90 mlprec/impl/mld_cprecinit.F90 mlprec/impl/mld_d_dec_map_bld.f90 mlprec/impl/mld_d_hierarchy_bld.f90 mlprec/impl/mld_d_lev_aggrmap_bld.f90 mlprec/impl/mld_d_lev_aggrmat_asb.f90 mlprec/impl/mld_d_smoothers_bld.f90 mlprec/impl/mld_daggrmap_bld.f90 mlprec/impl/mld_daggrmat_asb.f90 mlprec/impl/mld_daggrmat_biz_asb.f90 mlprec/impl/mld_daggrmat_minnrg_asb.f90 mlprec/impl/mld_daggrmat_nosmth_asb.f90 mlprec/impl/mld_daggrmat_smth_asb.f90 mlprec/impl/mld_dmlprec_aply.f90 mlprec/impl/mld_dmlprec_bld.f90 mlprec/impl/mld_dprecaply.f90 mlprec/impl/mld_dprecbld.f90 mlprec/impl/mld_dprecinit.F90 mlprec/impl/mld_s_dec_map_bld.f90 mlprec/impl/mld_s_hierarchy_bld.f90 mlprec/impl/mld_s_lev_aggrmap_bld.f90 mlprec/impl/mld_s_lev_aggrmat_asb.f90 mlprec/impl/mld_s_smoothers_bld.f90 mlprec/impl/mld_saggrmap_bld.f90 mlprec/impl/mld_saggrmat_asb.f90 mlprec/impl/mld_saggrmat_biz_asb.f90 mlprec/impl/mld_saggrmat_minnrg_asb.f90 mlprec/impl/mld_saggrmat_nosmth_asb.f90 mlprec/impl/mld_saggrmat_smth_asb.f90 mlprec/impl/mld_smlprec_aply.f90 mlprec/impl/mld_smlprec_bld.f90 mlprec/impl/mld_sprecaply.f90 mlprec/impl/mld_sprecbld.f90 mlprec/impl/mld_sprecinit.F90 mlprec/impl/mld_z_dec_map_bld.f90 mlprec/impl/mld_z_hierarchy_bld.f90 mlprec/impl/mld_z_lev_aggrmap_bld.f90 mlprec/impl/mld_z_lev_aggrmat_asb.f90 mlprec/impl/mld_z_smoothers_bld.f90 mlprec/impl/mld_zaggrmap_bld.f90 mlprec/impl/mld_zaggrmat_asb.f90 mlprec/impl/mld_zaggrmat_biz_asb.f90 mlprec/impl/mld_zaggrmat_minnrg_asb.f90 mlprec/impl/mld_zaggrmat_nosmth_asb.f90 mlprec/impl/mld_zaggrmat_smth_asb.f90 mlprec/impl/mld_zmlprec_aply.f90 mlprec/impl/mld_zmlprec_bld.f90 mlprec/impl/mld_zprecaply.f90 mlprec/impl/mld_zprecbld.f90 mlprec/impl/mld_zprecinit.F90 mlprec/impl/smoother/Makefile mlprec/impl/solver/Makefile mlprec/mld_c_inner_mod.f90 mlprec/mld_c_onelev_mod.f90 mlprec/mld_c_prec_mod.f90 mlprec/mld_c_prec_type.f90 mlprec/mld_d_inner_mod.f90 mlprec/mld_d_onelev_mod.f90 mlprec/mld_d_prec_mod.f90 mlprec/mld_d_prec_type.f90 mlprec/mld_s_inner_mod.f90 mlprec/mld_s_onelev_mod.f90 mlprec/mld_s_prec_mod.f90 mlprec/mld_s_prec_type.f90 mlprec/mld_z_inner_mod.f90 mlprec/mld_z_onelev_mod.f90 mlprec/mld_z_prec_mod.f90 mlprec/mld_z_prec_type.f90 tests/fileread/Makefile tests/newslv/Makefile tests/pdegen/Makefile tests/pdegen/mld_d_pde2d.f90 tests/pdegen/mld_d_pde3d.f90 tests/pdegen/runs/mld_pde3d.inp Merged changes from fixprec branch.
This commit is contained in:
Salvatore Filippone
@@ -1,5 +1,13 @@
|
||||
Changelog. A lot less detailed than usual, at least for past
|
||||
history.
|
||||
2017/04/03: Remove obsolete stuff.
|
||||
2017/03/17: Fixed level%cnv; add coarse _solver tracker.
|
||||
2017/02/18: Take out clean_zeros; changed NOFILTER; defined FBGS; take out
|
||||
n_prec_levs.
|
||||
2017/02/12: Updated mat_dist usage, dubious SP shell for UMFPACK, fixes
|
||||
for RPM packaging.
|
||||
2017/02/02: Fix superlu configury
|
||||
2016/11/12: Fix hierarchy/smoothers build to handle 1 level.
|
||||
2016/10/03: Merged changes to hierearchy building.
|
||||
2016/08/20: Reimplemented decoupled aggregation
|
||||
2016/07/20: Refactored application of multilevel. Defined V,W and
|
||||
|
||||
+8
-3
@@ -704,7 +704,7 @@ fi
|
||||
if test "x$mld2p4_cv_superludistlibdir" != "x"; then
|
||||
SLUDIST_LIBS="-L$mld2p4_cv_superludistlibdir"
|
||||
elif test "x$mld2p4_cv_superludistdir" != "x"; then
|
||||
SLUDIST_LIBS="-L$mld2p4_cv_superludir"
|
||||
SLUDIST_LIBS="-L$mld2p4_cv_superludistdir"
|
||||
fi
|
||||
|
||||
LIBS="$SLUDIST_LIBS $save_LIBS"
|
||||
@@ -721,7 +721,7 @@ dnl Maybe Include or include subdirs?
|
||||
|
||||
AC_CHECK_HEADERS([superlu_ddefs.h],
|
||||
[pac_sludist_header_ok=yes],
|
||||
[pac_sludist_header_ok=no; SLUDIST_INCLUDES=""])
|
||||
[pac_sludist_header_ok=no; SLUDIST_INCLUDES=""; SLUDIST_LIBS=""; ])
|
||||
fi
|
||||
|
||||
if test "x$pac_sludist_header_ok" == "xyes" ; then
|
||||
@@ -742,6 +742,7 @@ if test "x$pac_sludist_header_ok" == "xyes" ; then
|
||||
SLUDIST_LIBS="";SLUDIST_INCLUDES=""])
|
||||
fi
|
||||
AC_MSG_RESULT($pac_sludist_lib_ok)
|
||||
if test "x$pac_sludist_lib_ok" == "xyes" ; then
|
||||
AC_MSG_CHECKING([for superlu_dist version 4])
|
||||
AC_LANG_PUSH([C])
|
||||
ac_cc=${MPICC-$CC}
|
||||
@@ -770,8 +771,12 @@ if test "x$pac_sludist_header_ok" == "xyes" ; then
|
||||
[ AC_MSG_RESULT([no]); pac_sludist_version="4";])
|
||||
AC_LANG_POP([C])
|
||||
|
||||
fi
|
||||
fi
|
||||
else
|
||||
SLUDIST_LIBS="";
|
||||
SLUDIST_INCLUDES="";
|
||||
fi
|
||||
fi
|
||||
|
||||
LIBS="$save_LIBS";
|
||||
CPPFLAGS="$save_CPPFLAGS";
|
||||
|
||||
+53
-91
@@ -34,11 +34,11 @@ dnl NOTE : odd configurations like ifc + gcc still await in the mist of the unkn
|
||||
###############################################################################
|
||||
|
||||
# NOTE: the literal for version (the second argument to AC_INIT should be a literal!)
|
||||
AC_INIT([MLD2P4],2.0, bugreport@mld2p4.it)
|
||||
AC_INIT([MLD2P4],2.1, bugreport@mld2p4.it)
|
||||
|
||||
# VERSION is the file containing the PSBLAS version code
|
||||
# FIXME
|
||||
mld2p4_cv_version="2.0"
|
||||
mld2p4_cv_version="2.1"
|
||||
|
||||
# A sample source file
|
||||
AC_CONFIG_SRCDIR([mlprec/mld_prec_type.f90])
|
||||
@@ -119,13 +119,26 @@ case $samplesdir in
|
||||
esac
|
||||
AC_MSG_RESULT([$INSTALL_DIR $INSTALL_INCLUDEDIR $INSTALL_LIBDIR $INSTALL_DOCSDIR $INSTALL_SAMPLESDIR])
|
||||
|
||||
###############################################################################
|
||||
# Compilers detection: FC,F77,CC should be set, if found.
|
||||
###############################################################################
|
||||
dnl
|
||||
dnl We set our own FC flags, ignore those from AC_PROG_FC but not those from the
|
||||
dnl environment variable. Same for C
|
||||
dnl
|
||||
save_FCFLAGS="$FCFLAGS";
|
||||
AC_PROG_FC([ftn xlf2003_r xlf2003 xlf95_r xlf95 xlf90 xlf pgf95 pgf90 ifort ifc nagfor gfortran])
|
||||
AC_PROG_CC([xlc pgcc icc gcc cc])
|
||||
FCFLAGS="$save_FCFLAGS";
|
||||
save_CFLAGS="$CFLAGS";
|
||||
AC_PROG_CC([xlc pgcc icc gcc cc ])
|
||||
CFLAGS="$save_CFLAGS";
|
||||
dnl AC_PROG_CXX
|
||||
|
||||
dnl AC_PROG_F90 doesn't exist, at the time of writing this !
|
||||
dnl AC_PROG_F90
|
||||
|
||||
# Sanity checks, although redundant (useful when debugging this configure.ac)!
|
||||
if test "X$FC" == "X" ; then
|
||||
AC_MSG_ERROR([Problem : No Fortran compiler specified nor found!])
|
||||
fi
|
||||
|
||||
if test "X$CC" == "X" ; then
|
||||
AC_MSG_ERROR([Problem : No C compiler specified nor found!])
|
||||
fi
|
||||
@@ -137,7 +150,7 @@ if eval "$FC -qversion 2>&1 | grep XL 2>/dev/null" ; then
|
||||
FDEFINES="$mld_cv_define_prepend-DXLF_10 $FDEFINES"
|
||||
fi
|
||||
|
||||
# Note : there coule be problems with old xlf compiler versions ( <10.1 )
|
||||
# Note : there could be problems with old xlf compiler versions ( <10.1 )
|
||||
# since (as far as it is known to us) -WF, is not used in earlier versions.
|
||||
# More problems could be undocumented yet.
|
||||
fi
|
||||
@@ -153,7 +166,6 @@ PAC_ARG_SERIAL_MPI
|
||||
if test x"$pac_cv_serial_mpi" == x"yes" ; then
|
||||
FAKEMPI="fakempi.o";
|
||||
MPIFC="$FC";
|
||||
MPIF77="$F77";
|
||||
MPICC="$CC";
|
||||
else
|
||||
AC_LANG([C])
|
||||
@@ -173,23 +185,13 @@ fi
|
||||
|
||||
ACX_MPI([], [AC_MSG_ERROR([[Cannot find any suitable MPI implementation for Fortran]])])
|
||||
|
||||
AC_LANG(Fortran 77)
|
||||
if test "X$MPIF77" = "X" ; then
|
||||
# This is our MPIFC compiler preference: it will override ACX_MPI's first try.
|
||||
AC_CHECK_PROGS([MPIF77],[mpxlf mpf77 mpif77 ftn])
|
||||
fi
|
||||
ACX_MPI([], [AC_MSG_ERROR([[Cannot find any suitable MPI implementation for Fortran 77]])])
|
||||
FC="$MPIFC" ;
|
||||
F77="$MPIF77";
|
||||
CC="$MPICC";
|
||||
fi
|
||||
|
||||
|
||||
# We leave a default language for the next checks.
|
||||
dnl AC_LANG([Fortran 77])
|
||||
AC_LANG([C])
|
||||
|
||||
dnl Now on, MPIFC should be set, as MPIF77 and MPICC
|
||||
dnl Now on, MPIFC should be set, and MPICC
|
||||
|
||||
###############################################################################
|
||||
# Sanity checks, although redundant (useful when debugging this configure.ac)!
|
||||
@@ -210,8 +212,6 @@ fi
|
||||
dnl NOTE : no spaces before the comma, and no brackets before the second argument!
|
||||
PAC_ARG_WITH_FLAGS(ccopt,CCOPT)
|
||||
PAC_ARG_WITH_FLAGS(fcopt,FCOPT)
|
||||
#PAC_ARG_WITH_FLAGS(f90copt,F90COPT)
|
||||
#PAC_ARG_WITH_FLAGS(ldflags,LDFLAGS)
|
||||
PAC_ARG_WITH_LIBS
|
||||
PAC_ARG_WITH_FLAGS(clibs,CLIBS)
|
||||
PAC_ARG_WITH_FLAGS(flibs,FLIBS)
|
||||
@@ -229,8 +229,12 @@ PAC_ARG_WITH_EXTRA_LIBS
|
||||
###############################################################################
|
||||
|
||||
###############################################################################
|
||||
# PSBLAS library presence checks
|
||||
# Compiler identification (sadly, it is necessary)
|
||||
###############################################################################
|
||||
psblas_cv_fc=""
|
||||
|
||||
dnl Do we use gfortran & co ? Compiler identification.
|
||||
dnl NOTE : in /autoconf/autoconf/fortran.m4 there are plenty of better tests!
|
||||
|
||||
PAC_CHECK_HAVE_GFORTRAN(
|
||||
[psblas_cv_fc="gcc"],
|
||||
@@ -268,7 +272,6 @@ if test x"$psblas_cv_fc" == "x" ; then
|
||||
elif eval "$MPIFC -v 2>&1 | grep NAG 2>/dev/null" ; then
|
||||
psblas_cv_fc="nag"
|
||||
FC="$MPIFC"
|
||||
F77="$MPIFC"
|
||||
else
|
||||
psblas_cv_fc=""
|
||||
# unsupported MPI Fortran compiler
|
||||
@@ -282,6 +285,12 @@ PAC_HAVE_MODERN_GFORTRAN(
|
||||
)
|
||||
fi
|
||||
|
||||
|
||||
###############################################################################
|
||||
# Linking, symbol mangling, and misc tests
|
||||
###############################################################################
|
||||
|
||||
# Note : This is functional to Make.inc rules and structure (see below).
|
||||
AC_LANG([C])
|
||||
AC_CHECK_SIZEOF(void *)
|
||||
# Define for platforms with 64 bit (void * ) pointers
|
||||
@@ -289,10 +298,6 @@ if test X"$ac_cv_sizeof_void_p" == X"8" ; then
|
||||
CDEFINES="-DPtr64Bits $CDEFINES"
|
||||
fi
|
||||
AC_LANG([Fortran])
|
||||
if test "X$psblas_cv_fc" == X"pg" ; then
|
||||
save_FC=$FC
|
||||
FC=$F77
|
||||
fi
|
||||
__AC_FC_NAME_MANGLING
|
||||
if test "X$psblas_cv_fc" == X"pg" ; then
|
||||
FC=$save_FC
|
||||
@@ -350,8 +355,10 @@ AC_MSG_RESULT([ $pac_f_c_names ])
|
||||
###############################################################################
|
||||
# Make.inc generation logic
|
||||
###############################################################################
|
||||
F90COPT="$FCOPT"
|
||||
|
||||
# Honor CFLAGS if they were specified explicitly, but --with-ccopt take precedence
|
||||
if test "X$CCOPT" == "X" ; then
|
||||
CCOPT="$CFLAGS";
|
||||
fi
|
||||
if test "X$CCOPT" == "X" ; then
|
||||
if test "X$psblas_cv_fc" == "Xgcc" ; then
|
||||
# note that no space should be placed around the equality symbol in assignements
|
||||
@@ -383,6 +390,10 @@ if test "X$CCOPT" == "X" ; then
|
||||
fi
|
||||
#CFLAGS="${CCOPT}"
|
||||
|
||||
# Honor FCFLAGS if they were specified explicitly, but --with-fcopt take precedence
|
||||
if test "X$FCOPT" == "X" ; then
|
||||
FCOPT="$FCFLAGS";
|
||||
fi
|
||||
if test "X$FCOPT" == "X" ; then
|
||||
if test "X$psblas_cv_fc" == "Xgcc" ; then
|
||||
# note that no space should be placed around the equality symbol in assignations
|
||||
@@ -414,60 +425,24 @@ if test "X$FCOPT" == "X" ; then
|
||||
fi
|
||||
if test "X$psblas_cv_fc" == X"nag" ; then
|
||||
# Add needed options
|
||||
FCOPT="$FCOPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv"
|
||||
fi
|
||||
#FFLAGS="${FCOPT}"
|
||||
|
||||
if test "X$F90COPT" == "X" ; then
|
||||
if test "X$psblas_cv_fc" == "Xgcc" ; then
|
||||
# note that no space should be placed around the equality symbol in assignations
|
||||
# Note : 'native' is valid _only_ on GCC/x86 (32/64 bits)
|
||||
F90COPT="-O3 $F90COPT"
|
||||
elif test "X$psblas_cv_fc" == X"xlf" ; then
|
||||
# XL compiler : consider using -qarch=auto
|
||||
F90COPT="-O3 -qarch=auto -qsuffix=f=f90:cpp=F90 -qlanglvl=extended $F90COPT"
|
||||
elif test "X$psblas_cv_fc" == X"ifc" ; then
|
||||
# other compilers ..
|
||||
F90COPT="-O3 $F90COPT"
|
||||
elif test "X$psblas_cv_fc" == X"pg" ; then
|
||||
# other compilers ..
|
||||
F90COPT="-fast $F90COPT"
|
||||
elif test "X$psblas_cv_fc" == X"sun" ; then
|
||||
F90COPT="-fast $F90COPT"
|
||||
elif test "X$psblas_cv_fc" == X"cray" ; then
|
||||
MPIFC="ftn"
|
||||
F90COPT="-O3 -em $F90COPT"
|
||||
elif test "X$psblas_cv_fc" == X"nag" ; then
|
||||
# NAG compiler
|
||||
F90COPT="-O2"
|
||||
else
|
||||
# other compilers ..
|
||||
F90COPT="-O2 $F90COPT"
|
||||
fi
|
||||
else
|
||||
echo "Found FCFLAGS $F90COPT"
|
||||
#F90COPT="${FCFLAGS}"
|
||||
fi
|
||||
if test "X$psblas_cv_fc" == X"nag" ; then
|
||||
# Add needed options
|
||||
F90COPT="$F90COPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv"
|
||||
FCOPT="$FCOPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv"
|
||||
EXTRA_OPT="-mismatch_all"
|
||||
fi
|
||||
|
||||
#FCFLAGS="${F90COPT}"
|
||||
|
||||
# COPT,FCOPT, F90COPT are aliases for FFLAGS,CFLAGS,FCFLAGS .
|
||||
# COPT,FCOPT are aliases for CFLAGS,FCFLAGS .
|
||||
|
||||
##############################################################################
|
||||
# Compilers variables selection
|
||||
##############################################################################
|
||||
F90=${FC}
|
||||
MPF90=${MPIFC}
|
||||
FC=${FC}
|
||||
MPF77=${MPIFC}
|
||||
CC=${CC}
|
||||
MPCC=${MPICC}
|
||||
|
||||
|
||||
##############################################################################
|
||||
# Choice of our compilers, needed by Make.inc
|
||||
##############################################################################
|
||||
if test "X$psblas_cv_fc" == X"cray"
|
||||
then
|
||||
MODEXT=".mod"
|
||||
@@ -495,14 +470,9 @@ fi
|
||||
# Choice of our compilers, needed by Make.inc
|
||||
##############################################################################
|
||||
if test "X$FLINK" == "X" ; then
|
||||
FLINK=${MPF77}
|
||||
FLINK=${MPF90}
|
||||
fi
|
||||
|
||||
if test "X$F90LINK" == "X" ; then
|
||||
F90LINK=${MPF90}
|
||||
fi
|
||||
|
||||
|
||||
PAC_FORTRAN_HAVE_PSBLAS([AC_MSG_RESULT([yes.])],
|
||||
[AC_MSG_ERROR([no. Could not find working version of PSBLAS.])])
|
||||
|
||||
@@ -518,8 +488,8 @@ if test "x$pac_cv_psblas_patchlevel" == "xunknown"; then
|
||||
AC_MSG_ERROR([PSBLAS patchlevel "$pac_cv_psblas_patchlevel".])
|
||||
fi
|
||||
if (( $pac_cv_psblas_major < 3 )) ||
|
||||
( (( $pac_cv_psblas_major == 3 )) && (( $pac_cv_psblas_minor < 4 ))) ; then
|
||||
AC_MSG_ERROR([I need at least PSBLAS version 3.4.])
|
||||
( (( $pac_cv_psblas_major == 3 )) && (( $pac_cv_psblas_minor < 5 ))) ; then
|
||||
AC_MSG_ERROR([I need at least PSBLAS version 3.5.])
|
||||
else
|
||||
AC_MSG_NOTICE([Am configuring with PSBLAS version $pac_cv_psblas_major.$pac_cv_psblas_minor.$pac_cv_psblas_patchlevel.])
|
||||
fi
|
||||
@@ -702,28 +672,21 @@ if test "x$pac_cv_status_file" != "xNONE"; then
|
||||
COMPILERULES='';
|
||||
else
|
||||
COMPILERULES='
|
||||
F90LINK=$(MPF90)
|
||||
FLINK=$(MPF77)
|
||||
FLINK=$(MPF90)
|
||||
|
||||
# These should be portable rules, arent they?
|
||||
.c.o:
|
||||
$(CC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $< -o $@
|
||||
.f.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $< -o $@
|
||||
.f90.o:
|
||||
$(F90) $(FCOPT) $(FINCLUDES) -c $< -o $@
|
||||
.F.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $< -o $@
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $< -o $@
|
||||
.F90.o:
|
||||
$(F90) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $< -o $@'
|
||||
$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $< -o $@'
|
||||
|
||||
COMPILERULES="
|
||||
# The following ones are the variables used by the PSBLAS make scripts.
|
||||
|
||||
F90=$F90
|
||||
FC=$FC
|
||||
CC=$CC
|
||||
F90COPT=$F90COPT
|
||||
FCOPT=$FCOPT
|
||||
CCOPT=$CCOPT
|
||||
FMFLAG=$FMFLAG
|
||||
@@ -739,8 +702,7 @@ LIBS=$LIBS
|
||||
BLAS=$BLAS_LIBS
|
||||
|
||||
# These three should be always set!
|
||||
MPF90=$MPF90
|
||||
MPF77=$MPF77
|
||||
MPFC=$MPFC
|
||||
MPCC=$MPCC
|
||||
|
||||
AR=$AR
|
||||
|
||||
@@ -20,12 +20,12 @@ all: mld_dexample_ml mld_dexample_1lev mld_zexample_ml mld_zexample_1lev\
|
||||
mld_sexample_ml mld_sexample_1lev mld_cexample_ml mld_cexample_1lev
|
||||
|
||||
mld_dexample_ml: $(DMOBJS)
|
||||
$(F90LINK) $(LINKOPT) $(DMOBJS) -o mld_dexample_ml \
|
||||
$(FLINK) $(LINKOPT) $(DMOBJS) -o mld_dexample_ml \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_dexample_ml $(EXEDIR)
|
||||
|
||||
mld_dexample_1lev: $(D1OBJS)
|
||||
$(F90LINK) $(LINKOPT) $(D1OBJS) -o mld_dexample_1lev \
|
||||
$(FLINK) $(LINKOPT) $(D1OBJS) -o mld_dexample_1lev \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_dexample_1lev $(EXEDIR)
|
||||
|
||||
@@ -33,12 +33,12 @@ mld_dexample_ml.o: data_input.o
|
||||
mld_dexample_1lev.o: data_input.o
|
||||
|
||||
mld_zexample_ml: $(ZMOBJS)
|
||||
$(F90LINK) $(LINKOPT) $(ZMOBJS) -o mld_zexample_ml \
|
||||
$(FLINK) $(LINKOPT) $(ZMOBJS) -o mld_zexample_ml \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_zexample_ml $(EXEDIR)
|
||||
|
||||
mld_zexample_1lev: $(Z1OBJS)
|
||||
$(F90LINK) $(LINKOPT) $(Z1OBJS) -o mld_zexample_1lev \
|
||||
$(FLINK) $(LINKOPT) $(Z1OBJS) -o mld_zexample_1lev \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_zexample_1lev $(EXEDIR)
|
||||
|
||||
@@ -48,12 +48,12 @@ mld_zexample_1lev.o: data_input.o
|
||||
|
||||
|
||||
mld_sexample_ml: $(SMOBJS)
|
||||
$(F90LINK) $(LINKOPT) $(SMOBJS) -o mld_sexample_ml \
|
||||
$(FLINK) $(LINKOPT) $(SMOBJS) -o mld_sexample_ml \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_sexample_ml $(EXEDIR)
|
||||
|
||||
mld_sexample_1lev: $(S1OBJS)
|
||||
$(F90LINK) $(LINKOPT) $(S1OBJS) -o mld_sexample_1lev \
|
||||
$(FLINK) $(LINKOPT) $(S1OBJS) -o mld_sexample_1lev \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_sexample_1lev $(EXEDIR)
|
||||
|
||||
@@ -61,12 +61,12 @@ mld_sexample_ml.o: data_input.o
|
||||
mld_sexample_1lev.o: data_input.o
|
||||
|
||||
mld_cexample_ml: $(CMOBJS)
|
||||
$(F90LINK) $(LINKOPT) $(CMOBJS) -o mld_cexample_ml \
|
||||
$(FLINK) $(LINKOPT) $(CMOBJS) -o mld_cexample_ml \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_cexample_ml $(EXEDIR)
|
||||
|
||||
mld_cexample_1lev: $(C1OBJS)
|
||||
$(F90LINK) $(LINKOPT) $(C1OBJS) -o mld_cexample_1lev \
|
||||
$(FLINK) $(LINKOPT) $(C1OBJS) -o mld_cexample_1lev \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_cexample_1lev $(EXEDIR)
|
||||
|
||||
@@ -74,9 +74,6 @@ mld_cexample_ml.o: data_input.o
|
||||
mld_cexample_1lev.o: data_input.o
|
||||
|
||||
|
||||
.f90.o:
|
||||
$(MPF90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
|
||||
clean:
|
||||
/bin/rm -f *$(.mod) \
|
||||
$(DMOBJS) $(D1OBJS) $(ZMOBJS) $(Z1OBJS) \
|
||||
|
||||
@@ -16,12 +16,12 @@ all: mld_sexample_ml mld_sexample_1lev mld_dexample_ml mld_dexample_1lev
|
||||
|
||||
|
||||
mld_dexample_ml: $(DMOBJS)
|
||||
$(F90LINK) $(LINKOPT) $(DMOBJS) -o mld_dexample_ml \
|
||||
$(FLINK) $(LINKOPT) $(DMOBJS) -o mld_dexample_ml \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_dexample_ml $(EXEDIR)
|
||||
|
||||
mld_dexample_1lev: $(D1OBJS)
|
||||
$(F90LINK) $(LINKOPT) $(D1OBJS) -o mld_dexample_1lev \
|
||||
$(FLINK) $(LINKOPT) $(D1OBJS) -o mld_dexample_1lev \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_dexample_1lev $(EXEDIR)
|
||||
|
||||
@@ -29,21 +29,18 @@ mld_dexample_ml.o: data_input.o
|
||||
mld_dexample_1lev.o: data_input.o
|
||||
|
||||
mld_sexample_ml: $(SMOBJS)
|
||||
$(F90LINK) $(LINKOPT) $(SMOBJS) -o mld_sexample_ml \
|
||||
$(FLINK) $(LINKOPT) $(SMOBJS) -o mld_sexample_ml \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_sexample_ml $(EXEDIR)
|
||||
|
||||
mld_sexample_1lev: $(S1OBJS)
|
||||
$(F90LINK) $(LINKOPT) $(S1OBJS) -o mld_sexample_1lev \
|
||||
$(FLINK) $(LINKOPT) $(S1OBJS) -o mld_sexample_1lev \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_sexample_1lev $(EXEDIR)
|
||||
|
||||
mld_sexample_ml.o: data_input.o
|
||||
mld_sexample_1lev.o: data_input.o
|
||||
|
||||
.f90.o:
|
||||
$(MPF90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
|
||||
clean:
|
||||
/bin/rm -f $(DMOBJS) $(D1OBJS) $(SMOBJS) $(S1OBJS) \
|
||||
*$(.mod) $(EXEDIR)/mld_dexample_ml $(EXEDIR)/mld_dexample_1lev\
|
||||
|
||||
@@ -82,7 +82,7 @@ solvd:
|
||||
cd solver && $(MAKE)
|
||||
|
||||
mpobjs:
|
||||
(make $(MPFOBJS) F90="$(MPF90)" F90COPT="$(F90COPT)")
|
||||
(make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)")
|
||||
(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
|
||||
|
||||
veryclean: clean
|
||||
|
||||
@@ -71,7 +71,7 @@ lib: $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
|
||||
mpobjs:
|
||||
(make $(MPFOBJS) F90="$(MPF90)" F90COPT="$(F90COPT)")
|
||||
(make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)")
|
||||
(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
|
||||
|
||||
veryclean: clean
|
||||
|
||||
@@ -72,6 +72,7 @@
|
||||
subroutine mld_c_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_c_inner_mod, mld_protect_name => mld_c_dec_map_bld
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -65,7 +65,7 @@
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
!
|
||||
subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_inner_mod
|
||||
@@ -76,7 +76,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
! Arguments
|
||||
type(psb_cspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_cprec_type),intent(inout),target :: p
|
||||
class(mld_cprec_type),intent(inout),target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!!$ character, intent(in), optional :: upd
|
||||
|
||||
@@ -106,7 +106,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
int_err(1) = 0
|
||||
ictxt = desc_a%get_context()
|
||||
call psb_info(ictxt, me, np)
|
||||
p%ictxt = ictxt
|
||||
prec%ictxt = ictxt
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& 'Entering '
|
||||
@@ -127,7 +127,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
! !$ endif
|
||||
upd_ = 'F'
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
if (.not.allocated(prec%precv)) then
|
||||
!! Error: should have called mld_cprecinit
|
||||
info=3111
|
||||
call psb_errpush(info,name)
|
||||
@@ -138,31 +138,31 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
newsz = -1
|
||||
casize = p%coarse_aggr_size
|
||||
mxplevs = p%max_prec_levs
|
||||
mnaggratio = p%min_aggr_ratio
|
||||
casize = p%coarse_aggr_size
|
||||
iszv = size(p%precv)
|
||||
casize = prec%coarse_aggr_size
|
||||
mxplevs = prec%max_prec_levs
|
||||
mnaggratio = prec%min_aggr_ratio
|
||||
casize = prec%coarse_aggr_size
|
||||
iszv = size(prec%precv)
|
||||
call psb_bcast(ictxt,iszv)
|
||||
call psb_bcast(ictxt,casize)
|
||||
call psb_bcast(ictxt,mxplevs)
|
||||
call psb_bcast(ictxt,mnaggratio)
|
||||
if (casize /= p%coarse_aggr_size) then
|
||||
if (casize /= prec%coarse_aggr_size) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
|
||||
goto 9999
|
||||
end if
|
||||
if (mxplevs /= p%max_prec_levs) then
|
||||
if (mxplevs /= prec%max_prec_levs) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs')
|
||||
goto 9999
|
||||
end if
|
||||
if (mnaggratio /= p%min_aggr_ratio) then
|
||||
if (mnaggratio /= prec%min_aggr_ratio) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio')
|
||||
goto 9999
|
||||
end if
|
||||
if (iszv /= size(p%precv)) then
|
||||
if (iszv /= size(prec%precv)) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent size of precv')
|
||||
goto 9999
|
||||
@@ -182,8 +182,8 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
! This is OK, since it may be called by the user even if there
|
||||
! is only one level
|
||||
!
|
||||
p%precv(1)%base_a => a
|
||||
p%precv(1)%base_desc => desc_a
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -213,13 +213,13 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
end if
|
||||
nplevs = max(itwo,mxplevs)
|
||||
|
||||
coarseparms = p%precv(iszv)%parms
|
||||
baseparms = p%precv(1)%parms
|
||||
medparms = p%precv(2)%parms
|
||||
coarseparms = prec%precv(iszv)%parms
|
||||
baseparms = prec%precv(1)%parms
|
||||
medparms = prec%precv(2)%parms
|
||||
|
||||
call save_smoothers(p%precv(iszv),coarse_sm,coarse_sm2,info)
|
||||
if (info == 0) call save_smoothers(p%precv(2),med_sm,med_sm2,info)
|
||||
if (info == 0) call save_smoothers(p%precv(1),base_sm,base_sm2,info)
|
||||
call save_smoothers(prec%precv(iszv),coarse_sm,coarse_sm2,info)
|
||||
if (info == 0) call save_smoothers(prec%precv(2),med_sm,med_sm2,info)
|
||||
if (info == 0) call save_smoothers(prec%precv(1),base_sm,base_sm2,info)
|
||||
if (info /= psb_success_) then
|
||||
write(0,*) 'Error in saving smoothers',info
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
|
||||
@@ -232,10 +232,10 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
allocate(tprecv(nplevs),stat=info)
|
||||
! First all existing levels
|
||||
if (info == 0) tprecv(1)%parms = baseparms
|
||||
if (info == 0) call restore_smoothers(tprecv(1),p%precv(1)%sm,p%precv(1)%sm2a,info)
|
||||
if (info == 0) call restore_smoothers(tprecv(1),prec%precv(1)%sm,prec%precv(1)%sm2a,info)
|
||||
do i=2, min(iszv,nplevs) - 1
|
||||
if (info == 0) tprecv(i)%parms = medparms
|
||||
if (info == 0) call restore_smoothers(tprecv(i),p%precv(i)%sm,p%precv(i)%sm2a,info)
|
||||
if (info == 0) call restore_smoothers(tprecv(i),prec%precv(i)%sm,prec%precv(i)%sm2a,info)
|
||||
end do
|
||||
! Further intermediates, if any
|
||||
do i=iszv-1, nplevs - 1
|
||||
@@ -252,24 +252,24 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
endif
|
||||
|
||||
do i=1,iszv
|
||||
call p%precv(i)%free(info)
|
||||
call prec%precv(i)%free(info)
|
||||
end do
|
||||
call move_alloc(tprecv,p%precv)
|
||||
iszv = size(p%precv)
|
||||
call move_alloc(tprecv,prec%precv)
|
||||
iszv = size(prec%precv)
|
||||
end if
|
||||
|
||||
!
|
||||
! Finest level first; remember to fix base_a and base_desc
|
||||
!
|
||||
p%precv(1)%base_a => a
|
||||
p%precv(1)%base_desc => desc_a
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
newsz = 0
|
||||
array_build_loop: do i=2, iszv
|
||||
!
|
||||
! Check on the iprcparm contents: they should be the same
|
||||
! on all processes.
|
||||
!
|
||||
call psb_bcast(ictxt,p%precv(i)%parms)
|
||||
call psb_bcast(ictxt,prec%precv(i)%parms)
|
||||
|
||||
!
|
||||
! Sanity checks on the parameters
|
||||
@@ -278,7 +278,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
!
|
||||
! A replicated matrix only makes sense at the coarsest level
|
||||
!
|
||||
call mld_check_def(p%precv(i)%parms%coarse_mat,'Coarse matrix',&
|
||||
call mld_check_def(prec%precv(i)%parms%coarse_mat,'Coarse matrix',&
|
||||
& mld_distr_mat_,is_distr_ml_coarse_mat)
|
||||
end if
|
||||
|
||||
@@ -289,8 +289,8 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
! Build the mapping between levels i-1 and i and the matrix
|
||||
! at level i
|
||||
!
|
||||
if (info == psb_success_) call mld_aggrmap_bld(p%precv(i),&
|
||||
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,&
|
||||
if (info == psb_success_) call mld_aggrmap_bld(prec%precv(i),&
|
||||
& prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
@@ -305,7 +305,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
!
|
||||
! Save op_prol just in case
|
||||
!
|
||||
call op_prol%clone(p%precv(i)%tprol,info)
|
||||
call op_prol%clone(prec%precv(i)%tprol,info)
|
||||
!
|
||||
! Check for early termination of aggregation loop.
|
||||
!
|
||||
@@ -315,9 +315,9 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
if (i==2) then
|
||||
sizeratio = desc_a%get_global_rows()/sizeratio
|
||||
else
|
||||
sizeratio = sum(p%precv(i-1)%map%naggr)/sizeratio
|
||||
sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
|
||||
end if
|
||||
p%precv(i)%szratio = sizeratio
|
||||
prec%precv(i)%szratio = sizeratio
|
||||
if (iaggsize <= casize) then
|
||||
newsz = i
|
||||
end if
|
||||
@@ -334,7 +334,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
end if
|
||||
end if
|
||||
|
||||
if (all(nlaggr == p%precv(i-1)%map%naggr)) then
|
||||
if (all(nlaggr == prec%precv(i-1)%map%naggr)) then
|
||||
newsz=i-1
|
||||
if (me == 0) then
|
||||
write(debug_unit,*) trim(name),&
|
||||
@@ -356,27 +356,27 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
! This is awkward, we are saving the aggregation parms, for the sake
|
||||
! of distr/repl matrix at coarse level. Should be rethought.
|
||||
!
|
||||
athresh = p%precv(newsz)%parms%aggr_thresh
|
||||
ascale = p%precv(newsz)%parms%aggr_scale
|
||||
aomega = p%precv(newsz)%parms%aggr_omega_val
|
||||
if (info == 0) p%precv(newsz)%parms = coarseparms
|
||||
p%precv(newsz)%parms%aggr_thresh = athresh
|
||||
p%precv(newsz)%parms%aggr_scale = ascale
|
||||
p%precv(newsz)%parms%aggr_omega_val = aomega
|
||||
athresh = prec%precv(newsz)%parms%aggr_thresh
|
||||
ascale = prec%precv(newsz)%parms%aggr_scale
|
||||
aomega = prec%precv(newsz)%parms%aggr_omega_val
|
||||
if (info == 0) prec%precv(newsz)%parms = coarseparms
|
||||
prec%precv(newsz)%parms%aggr_thresh = athresh
|
||||
prec%precv(newsz)%parms%aggr_scale = ascale
|
||||
prec%precv(newsz)%parms%aggr_omega_val = aomega
|
||||
|
||||
if (info == 0) call restore_smoothers(p%precv(newsz),coarse_sm,coarse_sm2,info)
|
||||
if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info)
|
||||
if (newsz < i) then
|
||||
!
|
||||
! We are going back and revisit a previous leve;
|
||||
! recover the aggregation.
|
||||
!
|
||||
ilaggr = p%precv(newsz)%map%iaggr
|
||||
nlaggr = p%precv(newsz)%map%naggr
|
||||
call p%precv(newsz)%tprol%clone(op_prol,info)
|
||||
ilaggr = prec%precv(newsz)%map%iaggr
|
||||
nlaggr = prec%precv(newsz)%map%naggr
|
||||
call prec%precv(newsz)%tprol%clone(op_prol,info)
|
||||
end if
|
||||
|
||||
if (info == psb_success_) call mld_lev_mat_asb(p%precv(newsz),&
|
||||
& p%precv(newsz-1)%base_a,p%precv(newsz-1)%base_desc,&
|
||||
if (info == psb_success_) call mld_lev_mat_asb(prec%precv(newsz),&
|
||||
& prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
@@ -385,8 +385,8 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
endif
|
||||
exit array_build_loop
|
||||
else
|
||||
if (info == psb_success_) call mld_lev_mat_asb(p%precv(i),&
|
||||
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,&
|
||||
if (info == psb_success_) call mld_lev_mat_asb(prec%precv(i),&
|
||||
& prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
@@ -409,12 +409,12 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
goto 9999
|
||||
endif
|
||||
do i=1,newsz
|
||||
call p%precv(i)%move_alloc(tprecv(i),info)
|
||||
call prec%precv(i)%move_alloc(tprecv(i),info)
|
||||
end do
|
||||
do i=newsz+1, iszv
|
||||
call p%precv(i)%free(info)
|
||||
call prec%precv(i)%free(info)
|
||||
end do
|
||||
call move_alloc(tprecv,p%precv)
|
||||
call move_alloc(tprecv,prec%precv)
|
||||
! Ignore errors from transfer
|
||||
info = psb_success_
|
||||
!
|
||||
@@ -423,10 +423,10 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
! Fix the pointers, but the level 1 should
|
||||
! be already OK
|
||||
do i=2, iszv
|
||||
p%precv(i)%base_a => p%precv(i)%ac
|
||||
p%precv(i)%base_desc => p%precv(i)%desc_ac
|
||||
p%precv(i)%map%p_desc_X => p%precv(i-1)%base_desc
|
||||
p%precv(i)%map%p_desc_Y => p%precv(i)%base_desc
|
||||
prec%precv(i)%base_a => prec%precv(i)%ac
|
||||
prec%precv(i)%base_desc => prec%precv(i)%desc_ac
|
||||
prec%precv(i)%map%p_desc_X => prec%precv(i-1)%base_desc
|
||||
prec%precv(i)%map%p_desc_Y => prec%precv(i)%base_desc
|
||||
end do
|
||||
end if
|
||||
|
||||
@@ -436,9 +436,9 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
iszv = size(p%precv)
|
||||
iszv = size(prec%precv)
|
||||
|
||||
call p%cmp_complexity()
|
||||
call prec%cmp_complexity()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
|
||||
@@ -1,3 +1,4 @@
|
||||
|
||||
!
|
||||
!
|
||||
! MLD2P4 version 2.1
|
||||
@@ -77,6 +78,7 @@
|
||||
subroutine mld_c_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_c_inner_mod, mld_protect_name => mld_c_lev_aggrmap_bld
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -88,6 +88,7 @@
|
||||
subroutine mld_c_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_c_inner_mod, mld_protect_name => mld_c_lev_aggrmat_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -79,10 +79,10 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
subroutine mld_c_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
subroutine mld_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_inner_mod
|
||||
!use mld_c_inner_mod
|
||||
use mld_c_prec_mod, mld_protect_name => mld_c_smoothers_bld
|
||||
|
||||
Implicit None
|
||||
@@ -90,7 +90,7 @@ subroutine mld_c_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Arguments
|
||||
type(psb_cspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_cprec_type),intent(inout),target :: p
|
||||
class(mld_cprec_type),intent(inout),target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
@@ -140,7 +140,7 @@ subroutine mld_c_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! !$ endif
|
||||
upd_ = 'F'
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
if (.not.allocated(prec%precv)) then
|
||||
!! Error: should have called mld_cprecinit
|
||||
info=3111
|
||||
call psb_errpush(info,name)
|
||||
@@ -150,9 +150,9 @@ subroutine mld_c_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
iszv = size(p%precv)
|
||||
iszv = size(prec%precv)
|
||||
call psb_bcast(ictxt,iszv)
|
||||
if (iszv /= size(p%precv)) then
|
||||
if (iszv /= size(prec%precv)) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent size of precv')
|
||||
goto 9999
|
||||
@@ -174,7 +174,7 @@ subroutine mld_c_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!
|
||||
! build the base preconditioner at level i
|
||||
!
|
||||
call p%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold)
|
||||
call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
write(ch_err,'(a,i7)') 'Error @ level',i
|
||||
|
||||
@@ -88,6 +88,7 @@
|
||||
subroutine mld_caggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_c_inner_mod, mld_protect_name => mld_caggrmap_bld
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -120,6 +120,7 @@
|
||||
subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_c_inner_mod, mld_protect_name => mld_caggrmat_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -84,6 +84,7 @@
|
||||
!
|
||||
subroutine mld_caggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_c_inner_mod, mld_protect_name => mld_caggrmat_biz_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -112,6 +112,7 @@
|
||||
!
|
||||
subroutine mld_caggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_c_inner_mod, mld_protect_name => mld_caggrmat_minnrg_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -100,6 +100,7 @@
|
||||
!
|
||||
subroutine mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_c_inner_mod, mld_protect_name => mld_caggrmat_nosmth_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -113,6 +113,7 @@
|
||||
!
|
||||
subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_c_inner_mod, mld_protect_name => mld_caggrmat_smth_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -299,6 +299,7 @@
|
||||
subroutine mld_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_c_inner_mod, mld_protect_name => mld_cmlprec_aply_vect
|
||||
|
||||
implicit none
|
||||
@@ -1303,6 +1304,7 @@ end subroutine mld_cmlprec_aply_vect
|
||||
subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_c_inner_mod, mld_protect_name => mld_cmlprec_aply
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -123,7 +123,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& 'Entering '
|
||||
|
||||
call mld_c_hierarchy_bld(a,desc_a,p,info)
|
||||
call p%hierarchy_build(a,desc_a,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_internal_error_
|
||||
@@ -133,7 +133,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
|
||||
iszv = p%get_nlevs()
|
||||
|
||||
call mld_c_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
call p%smoothers_build(a,desc_a,info,amold,vmold,imold)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_internal_error_
|
||||
|
||||
@@ -75,7 +75,7 @@
|
||||
subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_inner_mod, mld_protect_name => mld_cprecaply
|
||||
use mld_c_inner_mod!, mld_protect_name => mld_cprecaply
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -206,7 +206,7 @@ end subroutine mld_cprecaply
|
||||
subroutine mld_cprecaply1(prec,x,desc_data,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_inner_mod, mld_protect_name => mld_cprecaply1
|
||||
use mld_c_inner_mod!, mld_protect_name => mld_cprecaply1
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -240,7 +240,7 @@ subroutine mld_cprecaply1(prec,x,desc_data,info,trans)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call mld_precaply(prec,x,ww,desc_data,info,trans=trans,work=w1)
|
||||
call prec%apply(x,ww,desc_data,info,trans=trans,work=w1)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precaply')
|
||||
goto 9999
|
||||
@@ -267,7 +267,7 @@ end subroutine mld_cprecaply1
|
||||
subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_inner_mod, mld_protect_name => mld_cprecaply2_vect
|
||||
use mld_c_inner_mod!, mld_protect_name => mld_cprecaply2_vect
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -368,7 +368,7 @@ end subroutine mld_cprecaply2_vect
|
||||
subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_inner_mod, mld_protect_name => mld_cprecaply1_vect
|
||||
use mld_c_inner_mod!, mld_protect_name => mld_cprecaply1_vect
|
||||
|
||||
implicit none
|
||||
|
||||
|
||||
@@ -59,10 +59,9 @@
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
!
|
||||
subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_inner_mod
|
||||
use mld_c_prec_mod, mld_protect_name => mld_cprecbld
|
||||
|
||||
Implicit None
|
||||
@@ -70,7 +69,7 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Arguments
|
||||
type(psb_cspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_cprec_type),intent(inout), target :: p
|
||||
class(mld_cprec_type),intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
@@ -100,7 +99,7 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
int_err(1) = 0
|
||||
ictxt = desc_a%get_context()
|
||||
call psb_info(ictxt, me, np)
|
||||
p%ictxt = ictxt
|
||||
prec%ictxt = ictxt
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
@@ -122,7 +121,7 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!!$ endif
|
||||
upd_ = 'F'
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
if (.not.allocated(prec%precv)) then
|
||||
!! Error: should have called mld_cprecinit
|
||||
info=3111
|
||||
call psb_errpush(info,name)
|
||||
@@ -133,9 +132,9 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
newsz = -1
|
||||
iszv = size(p%precv)
|
||||
iszv = size(prec%precv)
|
||||
call psb_bcast(ictxt,iszv)
|
||||
if (iszv /= size(p%precv)) then
|
||||
if (iszv /= size(prec%precv)) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent size of precv')
|
||||
goto 9999
|
||||
@@ -157,31 +156,31 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Check on the iprcparm contents: they should be the same
|
||||
! on all processes.
|
||||
!
|
||||
call psb_bcast(ictxt,p%precv(1)%parms)
|
||||
call psb_bcast(ictxt,prec%precv(1)%parms)
|
||||
|
||||
p%precv(1)%base_a => a
|
||||
p%precv(1)%base_desc => desc_a
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call p%precv(1)%check(info)
|
||||
if (info /= psb_success_) then
|
||||
write(0,*) ' Smoother check error',info
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner check.')
|
||||
goto 9999
|
||||
endif
|
||||
call prec%precv(1)%check(info)
|
||||
if (info /= psb_success_) then
|
||||
write(0,*) ' Smoother check error',info
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner check.')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call p%precv(1)%sm%build(a,desc_a,upd_,info,&
|
||||
& amold=amold,vmold=vmold,imold=imold)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner build.')
|
||||
goto 9999
|
||||
endif
|
||||
call prec%precv(1)%sm%build(a,desc_a,upd_,info,&
|
||||
& amold=amold,vmold=vmold,imold=imold)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner build.')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
!
|
||||
! Number of levels > 1
|
||||
@@ -190,16 +189,25 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!
|
||||
! Build the multilevel preconditioner
|
||||
!
|
||||
call mld_mlprec_bld(a,desc_a,p,info,&
|
||||
& amold=amold,vmold=vmold,imold=imold)
|
||||
call prec%hierarchy_build(a,desc_a,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='Multilevel preconditioner build.')
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Error from hierarchy build')
|
||||
goto 9999
|
||||
endif
|
||||
end if
|
||||
|
||||
|
||||
call prec%smoothers_build(a,desc_a,info,amold,vmold,imold)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Error from smoothers build')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
@@ -84,12 +84,8 @@
|
||||
! lowercase strings).
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
! nlev - integer, optional, input.
|
||||
! The number of levels of the multilevel preconditioner.
|
||||
! If nlev is not present and ptype='ML', then nlev=2
|
||||
! is assumed. If ptype /= 'ML', nlev is ignored.
|
||||
!
|
||||
subroutine mld_cprecinit(p,ptype,info,nlev)
|
||||
subroutine mld_cprecinit(prec,ptype,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_prec_mod, mld_protect_name => mld_cprecinit
|
||||
@@ -106,10 +102,9 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
type(mld_cprec_type), intent(inout) :: p
|
||||
class(mld_cprec_type), intent(inout) :: prec
|
||||
character(len=*), intent(in) :: ptype
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: nlev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: nlev_, ilev_
|
||||
@@ -117,97 +112,92 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
|
||||
character(len=*), parameter :: name='mld_precinit'
|
||||
info = psb_success_
|
||||
|
||||
if (allocated(p%precv)) then
|
||||
call mld_precfree(p,info)
|
||||
if (allocated(prec%precv)) then
|
||||
call prec%free(info)
|
||||
if (info /= psb_success_) then
|
||||
! Do we want to do something?
|
||||
endif
|
||||
endif
|
||||
p%coarse_aggr_size = -1
|
||||
prec%coarse_aggr_size = -1
|
||||
|
||||
select case(psb_toupper(ptype(1:len_trim(ptype))))
|
||||
case ('NOPREC','NONE')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_c_base_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_c_base_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_c_id_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_c_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
case ('JAC','DIAG','JACOBI')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_c_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_c_diag_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_c_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
case ('BJAC')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_c_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_c_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
case ('AS')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_c_as_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_c_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_c_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
|
||||
case ('ML')
|
||||
|
||||
if (present(nlev)) then
|
||||
nlev_ = max(1,nlev)
|
||||
p%max_prec_levs = nlev_
|
||||
else
|
||||
nlev_ = p%max_prec_levs
|
||||
end if
|
||||
nlev_ = prec%max_prec_levs
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_c_as_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_c_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_c_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
|
||||
if (nlev_ == 1) return
|
||||
do ilev_ = 2, nlev_ -1
|
||||
allocate(mld_c_as_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(mld_c_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_c_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
end do
|
||||
ilev_ = nlev_
|
||||
allocate(mld_c_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(mld_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
#if defined(HAVE_SLU_)
|
||||
allocate(mld_c_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
allocate(mld_c_slu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
#else
|
||||
allocate(mld_c_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
allocate(mld_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
#endif
|
||||
call p%precv(ilev_)%default()
|
||||
p%precv(ilev_)%parms%coarse_solve = mld_bjac_
|
||||
call p%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
|
||||
call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
|
||||
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
|
||||
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
|
||||
call prec%precv(ilev_)%default()
|
||||
prec%precv(ilev_)%parms%coarse_solve = mld_bjac_
|
||||
call prec%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
|
||||
call prec%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
|
||||
call prec%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
|
||||
call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info)
|
||||
|
||||
thr = 0.05_psb_spk_
|
||||
scale = 1.0_psb_spk_
|
||||
do ilev_=1,nlev_
|
||||
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
|
||||
call p%precv(ilev_)%set(mld_aggr_scale_,scale,info)
|
||||
call p%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info)
|
||||
call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
|
||||
call prec%precv(ilev_)%set(mld_aggr_scale_,scale,info)
|
||||
call prec%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info)
|
||||
end do
|
||||
|
||||
case default
|
||||
|
||||
@@ -72,6 +72,7 @@
|
||||
subroutine mld_d_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_d_inner_mod, mld_protect_name => mld_d_dec_map_bld
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -65,7 +65,7 @@
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
!
|
||||
subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_d_inner_mod
|
||||
@@ -76,7 +76,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
! Arguments
|
||||
type(psb_dspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_dprec_type),intent(inout),target :: p
|
||||
class(mld_dprec_type),intent(inout),target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!!$ character, intent(in), optional :: upd
|
||||
|
||||
@@ -106,7 +106,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
int_err(1) = 0
|
||||
ictxt = desc_a%get_context()
|
||||
call psb_info(ictxt, me, np)
|
||||
p%ictxt = ictxt
|
||||
prec%ictxt = ictxt
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& 'Entering '
|
||||
@@ -127,7 +127,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
! !$ endif
|
||||
upd_ = 'F'
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
if (.not.allocated(prec%precv)) then
|
||||
!! Error: should have called mld_dprecinit
|
||||
info=3111
|
||||
call psb_errpush(info,name)
|
||||
@@ -138,31 +138,31 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
newsz = -1
|
||||
casize = p%coarse_aggr_size
|
||||
mxplevs = p%max_prec_levs
|
||||
mnaggratio = p%min_aggr_ratio
|
||||
casize = p%coarse_aggr_size
|
||||
iszv = size(p%precv)
|
||||
casize = prec%coarse_aggr_size
|
||||
mxplevs = prec%max_prec_levs
|
||||
mnaggratio = prec%min_aggr_ratio
|
||||
casize = prec%coarse_aggr_size
|
||||
iszv = size(prec%precv)
|
||||
call psb_bcast(ictxt,iszv)
|
||||
call psb_bcast(ictxt,casize)
|
||||
call psb_bcast(ictxt,mxplevs)
|
||||
call psb_bcast(ictxt,mnaggratio)
|
||||
if (casize /= p%coarse_aggr_size) then
|
||||
if (casize /= prec%coarse_aggr_size) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
|
||||
goto 9999
|
||||
end if
|
||||
if (mxplevs /= p%max_prec_levs) then
|
||||
if (mxplevs /= prec%max_prec_levs) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs')
|
||||
goto 9999
|
||||
end if
|
||||
if (mnaggratio /= p%min_aggr_ratio) then
|
||||
if (mnaggratio /= prec%min_aggr_ratio) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio')
|
||||
goto 9999
|
||||
end if
|
||||
if (iszv /= size(p%precv)) then
|
||||
if (iszv /= size(prec%precv)) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent size of precv')
|
||||
goto 9999
|
||||
@@ -182,8 +182,8 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
! This is OK, since it may be called by the user even if there
|
||||
! is only one level
|
||||
!
|
||||
p%precv(1)%base_a => a
|
||||
p%precv(1)%base_desc => desc_a
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -213,13 +213,13 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
end if
|
||||
nplevs = max(itwo,mxplevs)
|
||||
|
||||
coarseparms = p%precv(iszv)%parms
|
||||
baseparms = p%precv(1)%parms
|
||||
medparms = p%precv(2)%parms
|
||||
coarseparms = prec%precv(iszv)%parms
|
||||
baseparms = prec%precv(1)%parms
|
||||
medparms = prec%precv(2)%parms
|
||||
|
||||
call save_smoothers(p%precv(iszv),coarse_sm,coarse_sm2,info)
|
||||
if (info == 0) call save_smoothers(p%precv(2),med_sm,med_sm2,info)
|
||||
if (info == 0) call save_smoothers(p%precv(1),base_sm,base_sm2,info)
|
||||
call save_smoothers(prec%precv(iszv),coarse_sm,coarse_sm2,info)
|
||||
if (info == 0) call save_smoothers(prec%precv(2),med_sm,med_sm2,info)
|
||||
if (info == 0) call save_smoothers(prec%precv(1),base_sm,base_sm2,info)
|
||||
if (info /= psb_success_) then
|
||||
write(0,*) 'Error in saving smoothers',info
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
|
||||
@@ -232,10 +232,10 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
allocate(tprecv(nplevs),stat=info)
|
||||
! First all existing levels
|
||||
if (info == 0) tprecv(1)%parms = baseparms
|
||||
if (info == 0) call restore_smoothers(tprecv(1),p%precv(1)%sm,p%precv(1)%sm2a,info)
|
||||
if (info == 0) call restore_smoothers(tprecv(1),prec%precv(1)%sm,prec%precv(1)%sm2a,info)
|
||||
do i=2, min(iszv,nplevs) - 1
|
||||
if (info == 0) tprecv(i)%parms = medparms
|
||||
if (info == 0) call restore_smoothers(tprecv(i),p%precv(i)%sm,p%precv(i)%sm2a,info)
|
||||
if (info == 0) call restore_smoothers(tprecv(i),prec%precv(i)%sm,prec%precv(i)%sm2a,info)
|
||||
end do
|
||||
! Further intermediates, if any
|
||||
do i=iszv-1, nplevs - 1
|
||||
@@ -252,24 +252,24 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
endif
|
||||
|
||||
do i=1,iszv
|
||||
call p%precv(i)%free(info)
|
||||
call prec%precv(i)%free(info)
|
||||
end do
|
||||
call move_alloc(tprecv,p%precv)
|
||||
iszv = size(p%precv)
|
||||
call move_alloc(tprecv,prec%precv)
|
||||
iszv = size(prec%precv)
|
||||
end if
|
||||
|
||||
!
|
||||
! Finest level first; remember to fix base_a and base_desc
|
||||
!
|
||||
p%precv(1)%base_a => a
|
||||
p%precv(1)%base_desc => desc_a
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
newsz = 0
|
||||
array_build_loop: do i=2, iszv
|
||||
!
|
||||
! Check on the iprcparm contents: they should be the same
|
||||
! on all processes.
|
||||
!
|
||||
call psb_bcast(ictxt,p%precv(i)%parms)
|
||||
call psb_bcast(ictxt,prec%precv(i)%parms)
|
||||
|
||||
!
|
||||
! Sanity checks on the parameters
|
||||
@@ -278,7 +278,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
!
|
||||
! A replicated matrix only makes sense at the coarsest level
|
||||
!
|
||||
call mld_check_def(p%precv(i)%parms%coarse_mat,'Coarse matrix',&
|
||||
call mld_check_def(prec%precv(i)%parms%coarse_mat,'Coarse matrix',&
|
||||
& mld_distr_mat_,is_distr_ml_coarse_mat)
|
||||
end if
|
||||
|
||||
@@ -289,8 +289,8 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
! Build the mapping between levels i-1 and i and the matrix
|
||||
! at level i
|
||||
!
|
||||
if (info == psb_success_) call mld_aggrmap_bld(p%precv(i),&
|
||||
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,&
|
||||
if (info == psb_success_) call mld_aggrmap_bld(prec%precv(i),&
|
||||
& prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
@@ -305,7 +305,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
!
|
||||
! Save op_prol just in case
|
||||
!
|
||||
call op_prol%clone(p%precv(i)%tprol,info)
|
||||
call op_prol%clone(prec%precv(i)%tprol,info)
|
||||
!
|
||||
! Check for early termination of aggregation loop.
|
||||
!
|
||||
@@ -315,9 +315,9 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
if (i==2) then
|
||||
sizeratio = desc_a%get_global_rows()/sizeratio
|
||||
else
|
||||
sizeratio = sum(p%precv(i-1)%map%naggr)/sizeratio
|
||||
sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
|
||||
end if
|
||||
p%precv(i)%szratio = sizeratio
|
||||
prec%precv(i)%szratio = sizeratio
|
||||
if (iaggsize <= casize) then
|
||||
newsz = i
|
||||
end if
|
||||
@@ -334,7 +334,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
end if
|
||||
end if
|
||||
|
||||
if (all(nlaggr == p%precv(i-1)%map%naggr)) then
|
||||
if (all(nlaggr == prec%precv(i-1)%map%naggr)) then
|
||||
newsz=i-1
|
||||
if (me == 0) then
|
||||
write(debug_unit,*) trim(name),&
|
||||
@@ -356,27 +356,27 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
! This is awkward, we are saving the aggregation parms, for the sake
|
||||
! of distr/repl matrix at coarse level. Should be rethought.
|
||||
!
|
||||
athresh = p%precv(newsz)%parms%aggr_thresh
|
||||
ascale = p%precv(newsz)%parms%aggr_scale
|
||||
aomega = p%precv(newsz)%parms%aggr_omega_val
|
||||
if (info == 0) p%precv(newsz)%parms = coarseparms
|
||||
p%precv(newsz)%parms%aggr_thresh = athresh
|
||||
p%precv(newsz)%parms%aggr_scale = ascale
|
||||
p%precv(newsz)%parms%aggr_omega_val = aomega
|
||||
athresh = prec%precv(newsz)%parms%aggr_thresh
|
||||
ascale = prec%precv(newsz)%parms%aggr_scale
|
||||
aomega = prec%precv(newsz)%parms%aggr_omega_val
|
||||
if (info == 0) prec%precv(newsz)%parms = coarseparms
|
||||
prec%precv(newsz)%parms%aggr_thresh = athresh
|
||||
prec%precv(newsz)%parms%aggr_scale = ascale
|
||||
prec%precv(newsz)%parms%aggr_omega_val = aomega
|
||||
|
||||
if (info == 0) call restore_smoothers(p%precv(newsz),coarse_sm,coarse_sm2,info)
|
||||
if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info)
|
||||
if (newsz < i) then
|
||||
!
|
||||
! We are going back and revisit a previous leve;
|
||||
! recover the aggregation.
|
||||
!
|
||||
ilaggr = p%precv(newsz)%map%iaggr
|
||||
nlaggr = p%precv(newsz)%map%naggr
|
||||
call p%precv(newsz)%tprol%clone(op_prol,info)
|
||||
ilaggr = prec%precv(newsz)%map%iaggr
|
||||
nlaggr = prec%precv(newsz)%map%naggr
|
||||
call prec%precv(newsz)%tprol%clone(op_prol,info)
|
||||
end if
|
||||
|
||||
if (info == psb_success_) call mld_lev_mat_asb(p%precv(newsz),&
|
||||
& p%precv(newsz-1)%base_a,p%precv(newsz-1)%base_desc,&
|
||||
if (info == psb_success_) call mld_lev_mat_asb(prec%precv(newsz),&
|
||||
& prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
@@ -385,8 +385,8 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
endif
|
||||
exit array_build_loop
|
||||
else
|
||||
if (info == psb_success_) call mld_lev_mat_asb(p%precv(i),&
|
||||
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,&
|
||||
if (info == psb_success_) call mld_lev_mat_asb(prec%precv(i),&
|
||||
& prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
@@ -409,12 +409,12 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
goto 9999
|
||||
endif
|
||||
do i=1,newsz
|
||||
call p%precv(i)%move_alloc(tprecv(i),info)
|
||||
call prec%precv(i)%move_alloc(tprecv(i),info)
|
||||
end do
|
||||
do i=newsz+1, iszv
|
||||
call p%precv(i)%free(info)
|
||||
call prec%precv(i)%free(info)
|
||||
end do
|
||||
call move_alloc(tprecv,p%precv)
|
||||
call move_alloc(tprecv,prec%precv)
|
||||
! Ignore errors from transfer
|
||||
info = psb_success_
|
||||
!
|
||||
@@ -423,10 +423,10 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
! Fix the pointers, but the level 1 should
|
||||
! be already OK
|
||||
do i=2, iszv
|
||||
p%precv(i)%base_a => p%precv(i)%ac
|
||||
p%precv(i)%base_desc => p%precv(i)%desc_ac
|
||||
p%precv(i)%map%p_desc_X => p%precv(i-1)%base_desc
|
||||
p%precv(i)%map%p_desc_Y => p%precv(i)%base_desc
|
||||
prec%precv(i)%base_a => prec%precv(i)%ac
|
||||
prec%precv(i)%base_desc => prec%precv(i)%desc_ac
|
||||
prec%precv(i)%map%p_desc_X => prec%precv(i-1)%base_desc
|
||||
prec%precv(i)%map%p_desc_Y => prec%precv(i)%base_desc
|
||||
end do
|
||||
end if
|
||||
|
||||
@@ -436,9 +436,9 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
iszv = size(p%precv)
|
||||
iszv = size(prec%precv)
|
||||
|
||||
call p%cmp_complexity()
|
||||
call prec%cmp_complexity()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
|
||||
@@ -1,3 +1,4 @@
|
||||
|
||||
!
|
||||
!
|
||||
! MLD2P4 version 2.1
|
||||
@@ -77,6 +78,7 @@
|
||||
subroutine mld_d_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_d_inner_mod, mld_protect_name => mld_d_lev_aggrmap_bld
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -88,6 +88,7 @@
|
||||
subroutine mld_d_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_d_inner_mod, mld_protect_name => mld_d_lev_aggrmat_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -79,10 +79,10 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
subroutine mld_d_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
subroutine mld_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_d_inner_mod
|
||||
!use mld_d_inner_mod
|
||||
use mld_d_prec_mod, mld_protect_name => mld_d_smoothers_bld
|
||||
|
||||
Implicit None
|
||||
@@ -90,7 +90,7 @@ subroutine mld_d_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Arguments
|
||||
type(psb_dspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_dprec_type),intent(inout),target :: p
|
||||
class(mld_dprec_type),intent(inout),target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
@@ -140,7 +140,7 @@ subroutine mld_d_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! !$ endif
|
||||
upd_ = 'F'
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
if (.not.allocated(prec%precv)) then
|
||||
!! Error: should have called mld_dprecinit
|
||||
info=3111
|
||||
call psb_errpush(info,name)
|
||||
@@ -150,9 +150,9 @@ subroutine mld_d_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
iszv = size(p%precv)
|
||||
iszv = size(prec%precv)
|
||||
call psb_bcast(ictxt,iszv)
|
||||
if (iszv /= size(p%precv)) then
|
||||
if (iszv /= size(prec%precv)) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent size of precv')
|
||||
goto 9999
|
||||
@@ -174,7 +174,7 @@ subroutine mld_d_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!
|
||||
! build the base preconditioner at level i
|
||||
!
|
||||
call p%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold)
|
||||
call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
write(ch_err,'(a,i7)') 'Error @ level',i
|
||||
|
||||
@@ -88,6 +88,7 @@
|
||||
subroutine mld_daggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_d_inner_mod, mld_protect_name => mld_daggrmap_bld
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -120,6 +120,7 @@
|
||||
subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_d_inner_mod, mld_protect_name => mld_daggrmat_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -84,6 +84,7 @@
|
||||
!
|
||||
subroutine mld_daggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_d_inner_mod, mld_protect_name => mld_daggrmat_biz_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -112,6 +112,7 @@
|
||||
!
|
||||
subroutine mld_daggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_d_inner_mod, mld_protect_name => mld_daggrmat_minnrg_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -100,6 +100,7 @@
|
||||
!
|
||||
subroutine mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_d_inner_mod, mld_protect_name => mld_daggrmat_nosmth_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -113,6 +113,7 @@
|
||||
!
|
||||
subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_d_inner_mod, mld_protect_name => mld_daggrmat_smth_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -299,6 +299,7 @@
|
||||
subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_d_inner_mod, mld_protect_name => mld_dmlprec_aply_vect
|
||||
|
||||
implicit none
|
||||
@@ -1303,6 +1304,7 @@ end subroutine mld_dmlprec_aply_vect
|
||||
subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_d_inner_mod, mld_protect_name => mld_dmlprec_aply
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -123,7 +123,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& 'Entering '
|
||||
|
||||
call mld_d_hierarchy_bld(a,desc_a,p,info)
|
||||
call p%hierarchy_build(a,desc_a,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_internal_error_
|
||||
@@ -133,7 +133,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
|
||||
iszv = p%get_nlevs()
|
||||
|
||||
call mld_d_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
call p%smoothers_build(a,desc_a,info,amold,vmold,imold)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_internal_error_
|
||||
|
||||
@@ -75,7 +75,7 @@
|
||||
subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_d_inner_mod, mld_protect_name => mld_dprecaply
|
||||
use mld_d_inner_mod!, mld_protect_name => mld_dprecaply
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -206,7 +206,7 @@ end subroutine mld_dprecaply
|
||||
subroutine mld_dprecaply1(prec,x,desc_data,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_d_inner_mod, mld_protect_name => mld_dprecaply1
|
||||
use mld_d_inner_mod!, mld_protect_name => mld_dprecaply1
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -240,7 +240,7 @@ subroutine mld_dprecaply1(prec,x,desc_data,info,trans)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call mld_precaply(prec,x,ww,desc_data,info,trans=trans,work=w1)
|
||||
call prec%apply(x,ww,desc_data,info,trans=trans,work=w1)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precaply')
|
||||
goto 9999
|
||||
@@ -267,7 +267,7 @@ end subroutine mld_dprecaply1
|
||||
subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_d_inner_mod, mld_protect_name => mld_dprecaply2_vect
|
||||
use mld_d_inner_mod!, mld_protect_name => mld_dprecaply2_vect
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -368,7 +368,7 @@ end subroutine mld_dprecaply2_vect
|
||||
subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_d_inner_mod, mld_protect_name => mld_dprecaply1_vect
|
||||
use mld_d_inner_mod!, mld_protect_name => mld_dprecaply1_vect
|
||||
|
||||
implicit none
|
||||
|
||||
|
||||
@@ -59,18 +59,17 @@
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
!
|
||||
subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_d_inner_mod, mld_protect_name1 => mld_dprecbld
|
||||
use mld_d_prec_mod, mld_protect_name2 => mld_dprecbld
|
||||
use mld_d_prec_mod, mld_protect_name => mld_dprecbld
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_dprec_type),intent(inout), target :: p
|
||||
class(mld_dprec_type),intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
@@ -100,7 +99,7 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
int_err(1) = 0
|
||||
ictxt = desc_a%get_context()
|
||||
call psb_info(ictxt, me, np)
|
||||
p%ictxt = ictxt
|
||||
prec%ictxt = ictxt
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
@@ -122,7 +121,7 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!!$ endif
|
||||
upd_ = 'F'
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
if (.not.allocated(prec%precv)) then
|
||||
!! Error: should have called mld_dprecinit
|
||||
info=3111
|
||||
call psb_errpush(info,name)
|
||||
@@ -133,9 +132,9 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
newsz = -1
|
||||
iszv = size(p%precv)
|
||||
iszv = size(prec%precv)
|
||||
call psb_bcast(ictxt,iszv)
|
||||
if (iszv /= size(p%precv)) then
|
||||
if (iszv /= size(prec%precv)) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent size of precv')
|
||||
goto 9999
|
||||
@@ -157,31 +156,31 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Check on the iprcparm contents: they should be the same
|
||||
! on all processes.
|
||||
!
|
||||
call psb_bcast(ictxt,p%precv(1)%parms)
|
||||
call psb_bcast(ictxt,prec%precv(1)%parms)
|
||||
|
||||
p%precv(1)%base_a => a
|
||||
p%precv(1)%base_desc => desc_a
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call p%precv(1)%check(info)
|
||||
if (info /= psb_success_) then
|
||||
write(0,*) ' Smoother check error',info
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner check.')
|
||||
goto 9999
|
||||
endif
|
||||
call prec%precv(1)%check(info)
|
||||
if (info /= psb_success_) then
|
||||
write(0,*) ' Smoother check error',info
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner check.')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call p%precv(1)%sm%build(a,desc_a,upd_,info,&
|
||||
& amold=amold,vmold=vmold,imold=imold)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner build.')
|
||||
goto 9999
|
||||
endif
|
||||
call prec%precv(1)%sm%build(a,desc_a,upd_,info,&
|
||||
& amold=amold,vmold=vmold,imold=imold)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner build.')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
!
|
||||
! Number of levels > 1
|
||||
@@ -190,16 +189,25 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!
|
||||
! Build the multilevel preconditioner
|
||||
!
|
||||
call mld_mlprec_bld(a,desc_a,p,info,&
|
||||
& amold=amold,vmold=vmold,imold=imold)
|
||||
call prec%hierarchy_build(a,desc_a,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='Multilevel preconditioner build.')
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Error from hierarchy build')
|
||||
goto 9999
|
||||
endif
|
||||
end if
|
||||
|
||||
|
||||
call prec%smoothers_build(a,desc_a,info,amold,vmold,imold)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Error from smoothers build')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
@@ -84,12 +84,8 @@
|
||||
! lowercase strings).
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
! nlev - integer, optional, input.
|
||||
! The number of levels of the multilevel preconditioner.
|
||||
! If nlev is not present and ptype='ML', then nlev=2
|
||||
! is assumed. If ptype /= 'ML', nlev is ignored.
|
||||
!
|
||||
subroutine mld_dprecinit(p,ptype,info,nlev)
|
||||
subroutine mld_dprecinit(prec,ptype,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_d_prec_mod, mld_protect_name => mld_dprecinit
|
||||
@@ -109,10 +105,9 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
type(mld_dprec_type), intent(inout) :: p
|
||||
class(mld_dprec_type), intent(inout) :: prec
|
||||
character(len=*), intent(in) :: ptype
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: nlev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: nlev_, ilev_
|
||||
@@ -120,99 +115,94 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
|
||||
character(len=*), parameter :: name='mld_precinit'
|
||||
info = psb_success_
|
||||
|
||||
if (allocated(p%precv)) then
|
||||
call mld_precfree(p,info)
|
||||
if (allocated(prec%precv)) then
|
||||
call prec%free(info)
|
||||
if (info /= psb_success_) then
|
||||
! Do we want to do something?
|
||||
endif
|
||||
endif
|
||||
p%coarse_aggr_size = -1
|
||||
prec%coarse_aggr_size = -1
|
||||
|
||||
select case(psb_toupper(ptype(1:len_trim(ptype))))
|
||||
case ('NOPREC','NONE')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_d_base_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_d_base_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_d_id_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_d_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
case ('JAC','DIAG','JACOBI')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_d_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_d_diag_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_d_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
case ('BJAC')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_d_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_d_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
case ('AS')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_d_as_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_d_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_d_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
|
||||
case ('ML')
|
||||
|
||||
if (present(nlev)) then
|
||||
nlev_ = max(1,nlev)
|
||||
p%max_prec_levs = nlev_
|
||||
else
|
||||
nlev_ = p%max_prec_levs
|
||||
end if
|
||||
nlev_ = prec%max_prec_levs
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_d_as_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_d_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_d_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
|
||||
if (nlev_ == 1) return
|
||||
do ilev_ = 2, nlev_ -1
|
||||
allocate(mld_d_as_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(mld_d_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_d_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
end do
|
||||
ilev_ = nlev_
|
||||
allocate(mld_d_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(mld_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
#if defined(HAVE_UMF_)
|
||||
allocate(mld_d_umf_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
allocate(mld_d_umf_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
#elif defined(HAVE_SLU_)
|
||||
allocate(mld_d_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
allocate(mld_d_slu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
#else
|
||||
allocate(mld_d_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
allocate(mld_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
#endif
|
||||
call p%precv(ilev_)%default()
|
||||
p%precv(ilev_)%parms%coarse_solve = mld_bjac_
|
||||
call p%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
|
||||
call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
|
||||
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
|
||||
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
|
||||
call prec%precv(ilev_)%default()
|
||||
prec%precv(ilev_)%parms%coarse_solve = mld_bjac_
|
||||
call prec%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
|
||||
call prec%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
|
||||
call prec%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
|
||||
call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info)
|
||||
|
||||
thr = 0.05_psb_dpk_
|
||||
scale = 1.0_psb_dpk_
|
||||
do ilev_=1,nlev_
|
||||
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
|
||||
call p%precv(ilev_)%set(mld_aggr_scale_,scale,info)
|
||||
call p%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info)
|
||||
call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
|
||||
call prec%precv(ilev_)%set(mld_aggr_scale_,scale,info)
|
||||
call prec%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info)
|
||||
end do
|
||||
|
||||
case default
|
||||
|
||||
@@ -72,6 +72,7 @@
|
||||
subroutine mld_s_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_s_inner_mod, mld_protect_name => mld_s_dec_map_bld
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -65,7 +65,7 @@
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
!
|
||||
subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_inner_mod
|
||||
@@ -76,7 +76,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
! Arguments
|
||||
type(psb_sspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_sprec_type),intent(inout),target :: p
|
||||
class(mld_sprec_type),intent(inout),target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!!$ character, intent(in), optional :: upd
|
||||
|
||||
@@ -106,7 +106,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
int_err(1) = 0
|
||||
ictxt = desc_a%get_context()
|
||||
call psb_info(ictxt, me, np)
|
||||
p%ictxt = ictxt
|
||||
prec%ictxt = ictxt
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& 'Entering '
|
||||
@@ -127,7 +127,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
! !$ endif
|
||||
upd_ = 'F'
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
if (.not.allocated(prec%precv)) then
|
||||
!! Error: should have called mld_sprecinit
|
||||
info=3111
|
||||
call psb_errpush(info,name)
|
||||
@@ -138,31 +138,31 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
newsz = -1
|
||||
casize = p%coarse_aggr_size
|
||||
mxplevs = p%max_prec_levs
|
||||
mnaggratio = p%min_aggr_ratio
|
||||
casize = p%coarse_aggr_size
|
||||
iszv = size(p%precv)
|
||||
casize = prec%coarse_aggr_size
|
||||
mxplevs = prec%max_prec_levs
|
||||
mnaggratio = prec%min_aggr_ratio
|
||||
casize = prec%coarse_aggr_size
|
||||
iszv = size(prec%precv)
|
||||
call psb_bcast(ictxt,iszv)
|
||||
call psb_bcast(ictxt,casize)
|
||||
call psb_bcast(ictxt,mxplevs)
|
||||
call psb_bcast(ictxt,mnaggratio)
|
||||
if (casize /= p%coarse_aggr_size) then
|
||||
if (casize /= prec%coarse_aggr_size) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
|
||||
goto 9999
|
||||
end if
|
||||
if (mxplevs /= p%max_prec_levs) then
|
||||
if (mxplevs /= prec%max_prec_levs) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs')
|
||||
goto 9999
|
||||
end if
|
||||
if (mnaggratio /= p%min_aggr_ratio) then
|
||||
if (mnaggratio /= prec%min_aggr_ratio) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio')
|
||||
goto 9999
|
||||
end if
|
||||
if (iszv /= size(p%precv)) then
|
||||
if (iszv /= size(prec%precv)) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent size of precv')
|
||||
goto 9999
|
||||
@@ -182,8 +182,8 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
! This is OK, since it may be called by the user even if there
|
||||
! is only one level
|
||||
!
|
||||
p%precv(1)%base_a => a
|
||||
p%precv(1)%base_desc => desc_a
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -213,13 +213,13 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
end if
|
||||
nplevs = max(itwo,mxplevs)
|
||||
|
||||
coarseparms = p%precv(iszv)%parms
|
||||
baseparms = p%precv(1)%parms
|
||||
medparms = p%precv(2)%parms
|
||||
coarseparms = prec%precv(iszv)%parms
|
||||
baseparms = prec%precv(1)%parms
|
||||
medparms = prec%precv(2)%parms
|
||||
|
||||
call save_smoothers(p%precv(iszv),coarse_sm,coarse_sm2,info)
|
||||
if (info == 0) call save_smoothers(p%precv(2),med_sm,med_sm2,info)
|
||||
if (info == 0) call save_smoothers(p%precv(1),base_sm,base_sm2,info)
|
||||
call save_smoothers(prec%precv(iszv),coarse_sm,coarse_sm2,info)
|
||||
if (info == 0) call save_smoothers(prec%precv(2),med_sm,med_sm2,info)
|
||||
if (info == 0) call save_smoothers(prec%precv(1),base_sm,base_sm2,info)
|
||||
if (info /= psb_success_) then
|
||||
write(0,*) 'Error in saving smoothers',info
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
|
||||
@@ -232,10 +232,10 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
allocate(tprecv(nplevs),stat=info)
|
||||
! First all existing levels
|
||||
if (info == 0) tprecv(1)%parms = baseparms
|
||||
if (info == 0) call restore_smoothers(tprecv(1),p%precv(1)%sm,p%precv(1)%sm2a,info)
|
||||
if (info == 0) call restore_smoothers(tprecv(1),prec%precv(1)%sm,prec%precv(1)%sm2a,info)
|
||||
do i=2, min(iszv,nplevs) - 1
|
||||
if (info == 0) tprecv(i)%parms = medparms
|
||||
if (info == 0) call restore_smoothers(tprecv(i),p%precv(i)%sm,p%precv(i)%sm2a,info)
|
||||
if (info == 0) call restore_smoothers(tprecv(i),prec%precv(i)%sm,prec%precv(i)%sm2a,info)
|
||||
end do
|
||||
! Further intermediates, if any
|
||||
do i=iszv-1, nplevs - 1
|
||||
@@ -252,24 +252,24 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
endif
|
||||
|
||||
do i=1,iszv
|
||||
call p%precv(i)%free(info)
|
||||
call prec%precv(i)%free(info)
|
||||
end do
|
||||
call move_alloc(tprecv,p%precv)
|
||||
iszv = size(p%precv)
|
||||
call move_alloc(tprecv,prec%precv)
|
||||
iszv = size(prec%precv)
|
||||
end if
|
||||
|
||||
!
|
||||
! Finest level first; remember to fix base_a and base_desc
|
||||
!
|
||||
p%precv(1)%base_a => a
|
||||
p%precv(1)%base_desc => desc_a
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
newsz = 0
|
||||
array_build_loop: do i=2, iszv
|
||||
!
|
||||
! Check on the iprcparm contents: they should be the same
|
||||
! on all processes.
|
||||
!
|
||||
call psb_bcast(ictxt,p%precv(i)%parms)
|
||||
call psb_bcast(ictxt,prec%precv(i)%parms)
|
||||
|
||||
!
|
||||
! Sanity checks on the parameters
|
||||
@@ -278,7 +278,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
!
|
||||
! A replicated matrix only makes sense at the coarsest level
|
||||
!
|
||||
call mld_check_def(p%precv(i)%parms%coarse_mat,'Coarse matrix',&
|
||||
call mld_check_def(prec%precv(i)%parms%coarse_mat,'Coarse matrix',&
|
||||
& mld_distr_mat_,is_distr_ml_coarse_mat)
|
||||
end if
|
||||
|
||||
@@ -289,8 +289,8 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
! Build the mapping between levels i-1 and i and the matrix
|
||||
! at level i
|
||||
!
|
||||
if (info == psb_success_) call mld_aggrmap_bld(p%precv(i),&
|
||||
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,&
|
||||
if (info == psb_success_) call mld_aggrmap_bld(prec%precv(i),&
|
||||
& prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
@@ -305,7 +305,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
!
|
||||
! Save op_prol just in case
|
||||
!
|
||||
call op_prol%clone(p%precv(i)%tprol,info)
|
||||
call op_prol%clone(prec%precv(i)%tprol,info)
|
||||
!
|
||||
! Check for early termination of aggregation loop.
|
||||
!
|
||||
@@ -315,9 +315,9 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
if (i==2) then
|
||||
sizeratio = desc_a%get_global_rows()/sizeratio
|
||||
else
|
||||
sizeratio = sum(p%precv(i-1)%map%naggr)/sizeratio
|
||||
sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
|
||||
end if
|
||||
p%precv(i)%szratio = sizeratio
|
||||
prec%precv(i)%szratio = sizeratio
|
||||
if (iaggsize <= casize) then
|
||||
newsz = i
|
||||
end if
|
||||
@@ -334,7 +334,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
end if
|
||||
end if
|
||||
|
||||
if (all(nlaggr == p%precv(i-1)%map%naggr)) then
|
||||
if (all(nlaggr == prec%precv(i-1)%map%naggr)) then
|
||||
newsz=i-1
|
||||
if (me == 0) then
|
||||
write(debug_unit,*) trim(name),&
|
||||
@@ -356,27 +356,27 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
! This is awkward, we are saving the aggregation parms, for the sake
|
||||
! of distr/repl matrix at coarse level. Should be rethought.
|
||||
!
|
||||
athresh = p%precv(newsz)%parms%aggr_thresh
|
||||
ascale = p%precv(newsz)%parms%aggr_scale
|
||||
aomega = p%precv(newsz)%parms%aggr_omega_val
|
||||
if (info == 0) p%precv(newsz)%parms = coarseparms
|
||||
p%precv(newsz)%parms%aggr_thresh = athresh
|
||||
p%precv(newsz)%parms%aggr_scale = ascale
|
||||
p%precv(newsz)%parms%aggr_omega_val = aomega
|
||||
athresh = prec%precv(newsz)%parms%aggr_thresh
|
||||
ascale = prec%precv(newsz)%parms%aggr_scale
|
||||
aomega = prec%precv(newsz)%parms%aggr_omega_val
|
||||
if (info == 0) prec%precv(newsz)%parms = coarseparms
|
||||
prec%precv(newsz)%parms%aggr_thresh = athresh
|
||||
prec%precv(newsz)%parms%aggr_scale = ascale
|
||||
prec%precv(newsz)%parms%aggr_omega_val = aomega
|
||||
|
||||
if (info == 0) call restore_smoothers(p%precv(newsz),coarse_sm,coarse_sm2,info)
|
||||
if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info)
|
||||
if (newsz < i) then
|
||||
!
|
||||
! We are going back and revisit a previous leve;
|
||||
! recover the aggregation.
|
||||
!
|
||||
ilaggr = p%precv(newsz)%map%iaggr
|
||||
nlaggr = p%precv(newsz)%map%naggr
|
||||
call p%precv(newsz)%tprol%clone(op_prol,info)
|
||||
ilaggr = prec%precv(newsz)%map%iaggr
|
||||
nlaggr = prec%precv(newsz)%map%naggr
|
||||
call prec%precv(newsz)%tprol%clone(op_prol,info)
|
||||
end if
|
||||
|
||||
if (info == psb_success_) call mld_lev_mat_asb(p%precv(newsz),&
|
||||
& p%precv(newsz-1)%base_a,p%precv(newsz-1)%base_desc,&
|
||||
if (info == psb_success_) call mld_lev_mat_asb(prec%precv(newsz),&
|
||||
& prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
@@ -385,8 +385,8 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
endif
|
||||
exit array_build_loop
|
||||
else
|
||||
if (info == psb_success_) call mld_lev_mat_asb(p%precv(i),&
|
||||
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,&
|
||||
if (info == psb_success_) call mld_lev_mat_asb(prec%precv(i),&
|
||||
& prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
@@ -409,12 +409,12 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
goto 9999
|
||||
endif
|
||||
do i=1,newsz
|
||||
call p%precv(i)%move_alloc(tprecv(i),info)
|
||||
call prec%precv(i)%move_alloc(tprecv(i),info)
|
||||
end do
|
||||
do i=newsz+1, iszv
|
||||
call p%precv(i)%free(info)
|
||||
call prec%precv(i)%free(info)
|
||||
end do
|
||||
call move_alloc(tprecv,p%precv)
|
||||
call move_alloc(tprecv,prec%precv)
|
||||
! Ignore errors from transfer
|
||||
info = psb_success_
|
||||
!
|
||||
@@ -423,10 +423,10 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
! Fix the pointers, but the level 1 should
|
||||
! be already OK
|
||||
do i=2, iszv
|
||||
p%precv(i)%base_a => p%precv(i)%ac
|
||||
p%precv(i)%base_desc => p%precv(i)%desc_ac
|
||||
p%precv(i)%map%p_desc_X => p%precv(i-1)%base_desc
|
||||
p%precv(i)%map%p_desc_Y => p%precv(i)%base_desc
|
||||
prec%precv(i)%base_a => prec%precv(i)%ac
|
||||
prec%precv(i)%base_desc => prec%precv(i)%desc_ac
|
||||
prec%precv(i)%map%p_desc_X => prec%precv(i-1)%base_desc
|
||||
prec%precv(i)%map%p_desc_Y => prec%precv(i)%base_desc
|
||||
end do
|
||||
end if
|
||||
|
||||
@@ -436,9 +436,9 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
iszv = size(p%precv)
|
||||
iszv = size(prec%precv)
|
||||
|
||||
call p%cmp_complexity()
|
||||
call prec%cmp_complexity()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
|
||||
@@ -1,3 +1,4 @@
|
||||
|
||||
!
|
||||
!
|
||||
! MLD2P4 version 2.1
|
||||
@@ -77,6 +78,7 @@
|
||||
subroutine mld_s_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_s_inner_mod, mld_protect_name => mld_s_lev_aggrmap_bld
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -88,6 +88,7 @@
|
||||
subroutine mld_s_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_s_inner_mod, mld_protect_name => mld_s_lev_aggrmat_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -79,10 +79,10 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
subroutine mld_s_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
subroutine mld_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_inner_mod
|
||||
!use mld_s_inner_mod
|
||||
use mld_s_prec_mod, mld_protect_name => mld_s_smoothers_bld
|
||||
|
||||
Implicit None
|
||||
@@ -90,7 +90,7 @@ subroutine mld_s_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Arguments
|
||||
type(psb_sspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_sprec_type),intent(inout),target :: p
|
||||
class(mld_sprec_type),intent(inout),target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
@@ -140,7 +140,7 @@ subroutine mld_s_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! !$ endif
|
||||
upd_ = 'F'
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
if (.not.allocated(prec%precv)) then
|
||||
!! Error: should have called mld_sprecinit
|
||||
info=3111
|
||||
call psb_errpush(info,name)
|
||||
@@ -150,9 +150,9 @@ subroutine mld_s_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
iszv = size(p%precv)
|
||||
iszv = size(prec%precv)
|
||||
call psb_bcast(ictxt,iszv)
|
||||
if (iszv /= size(p%precv)) then
|
||||
if (iszv /= size(prec%precv)) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent size of precv')
|
||||
goto 9999
|
||||
@@ -174,7 +174,7 @@ subroutine mld_s_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!
|
||||
! build the base preconditioner at level i
|
||||
!
|
||||
call p%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold)
|
||||
call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
write(ch_err,'(a,i7)') 'Error @ level',i
|
||||
|
||||
@@ -88,6 +88,7 @@
|
||||
subroutine mld_saggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_s_inner_mod, mld_protect_name => mld_saggrmap_bld
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -120,6 +120,7 @@
|
||||
subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_s_inner_mod, mld_protect_name => mld_saggrmat_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -84,6 +84,7 @@
|
||||
!
|
||||
subroutine mld_saggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_s_inner_mod, mld_protect_name => mld_saggrmat_biz_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -112,6 +112,7 @@
|
||||
!
|
||||
subroutine mld_saggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_s_inner_mod, mld_protect_name => mld_saggrmat_minnrg_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -100,6 +100,7 @@
|
||||
!
|
||||
subroutine mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_s_inner_mod, mld_protect_name => mld_saggrmat_nosmth_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -113,6 +113,7 @@
|
||||
!
|
||||
subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_s_inner_mod, mld_protect_name => mld_saggrmat_smth_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -299,6 +299,7 @@
|
||||
subroutine mld_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_s_inner_mod, mld_protect_name => mld_smlprec_aply_vect
|
||||
|
||||
implicit none
|
||||
@@ -1303,6 +1304,7 @@ end subroutine mld_smlprec_aply_vect
|
||||
subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_s_inner_mod, mld_protect_name => mld_smlprec_aply
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -123,7 +123,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& 'Entering '
|
||||
|
||||
call mld_s_hierarchy_bld(a,desc_a,p,info)
|
||||
call p%hierarchy_build(a,desc_a,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_internal_error_
|
||||
@@ -133,7 +133,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
|
||||
iszv = p%get_nlevs()
|
||||
|
||||
call mld_s_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
call p%smoothers_build(a,desc_a,info,amold,vmold,imold)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_internal_error_
|
||||
|
||||
@@ -75,7 +75,7 @@
|
||||
subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_inner_mod, mld_protect_name => mld_sprecaply
|
||||
use mld_s_inner_mod!, mld_protect_name => mld_sprecaply
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -206,7 +206,7 @@ end subroutine mld_sprecaply
|
||||
subroutine mld_sprecaply1(prec,x,desc_data,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_inner_mod, mld_protect_name => mld_sprecaply1
|
||||
use mld_s_inner_mod!, mld_protect_name => mld_sprecaply1
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -240,7 +240,7 @@ subroutine mld_sprecaply1(prec,x,desc_data,info,trans)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call mld_precaply(prec,x,ww,desc_data,info,trans=trans,work=w1)
|
||||
call prec%apply(x,ww,desc_data,info,trans=trans,work=w1)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precaply')
|
||||
goto 9999
|
||||
@@ -267,7 +267,7 @@ end subroutine mld_sprecaply1
|
||||
subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_inner_mod, mld_protect_name => mld_sprecaply2_vect
|
||||
use mld_s_inner_mod!, mld_protect_name => mld_sprecaply2_vect
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -368,7 +368,7 @@ end subroutine mld_sprecaply2_vect
|
||||
subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_inner_mod, mld_protect_name => mld_sprecaply1_vect
|
||||
use mld_s_inner_mod!, mld_protect_name => mld_sprecaply1_vect
|
||||
|
||||
implicit none
|
||||
|
||||
|
||||
@@ -59,10 +59,9 @@
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
!
|
||||
subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_inner_mod
|
||||
use mld_s_prec_mod, mld_protect_name => mld_sprecbld
|
||||
|
||||
Implicit None
|
||||
@@ -70,7 +69,7 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Arguments
|
||||
type(psb_sspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_sprec_type),intent(inout), target :: p
|
||||
class(mld_sprec_type),intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
@@ -100,7 +99,7 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
int_err(1) = 0
|
||||
ictxt = desc_a%get_context()
|
||||
call psb_info(ictxt, me, np)
|
||||
p%ictxt = ictxt
|
||||
prec%ictxt = ictxt
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
@@ -122,7 +121,7 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!!$ endif
|
||||
upd_ = 'F'
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
if (.not.allocated(prec%precv)) then
|
||||
!! Error: should have called mld_sprecinit
|
||||
info=3111
|
||||
call psb_errpush(info,name)
|
||||
@@ -133,9 +132,9 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
newsz = -1
|
||||
iszv = size(p%precv)
|
||||
iszv = size(prec%precv)
|
||||
call psb_bcast(ictxt,iszv)
|
||||
if (iszv /= size(p%precv)) then
|
||||
if (iszv /= size(prec%precv)) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent size of precv')
|
||||
goto 9999
|
||||
@@ -157,31 +156,31 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Check on the iprcparm contents: they should be the same
|
||||
! on all processes.
|
||||
!
|
||||
call psb_bcast(ictxt,p%precv(1)%parms)
|
||||
call psb_bcast(ictxt,prec%precv(1)%parms)
|
||||
|
||||
p%precv(1)%base_a => a
|
||||
p%precv(1)%base_desc => desc_a
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call p%precv(1)%check(info)
|
||||
if (info /= psb_success_) then
|
||||
write(0,*) ' Smoother check error',info
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner check.')
|
||||
goto 9999
|
||||
endif
|
||||
call prec%precv(1)%check(info)
|
||||
if (info /= psb_success_) then
|
||||
write(0,*) ' Smoother check error',info
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner check.')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call p%precv(1)%sm%build(a,desc_a,upd_,info,&
|
||||
& amold=amold,vmold=vmold,imold=imold)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner build.')
|
||||
goto 9999
|
||||
endif
|
||||
call prec%precv(1)%sm%build(a,desc_a,upd_,info,&
|
||||
& amold=amold,vmold=vmold,imold=imold)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner build.')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
!
|
||||
! Number of levels > 1
|
||||
@@ -190,16 +189,25 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!
|
||||
! Build the multilevel preconditioner
|
||||
!
|
||||
call mld_mlprec_bld(a,desc_a,p,info,&
|
||||
& amold=amold,vmold=vmold,imold=imold)
|
||||
call prec%hierarchy_build(a,desc_a,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='Multilevel preconditioner build.')
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Error from hierarchy build')
|
||||
goto 9999
|
||||
endif
|
||||
end if
|
||||
|
||||
|
||||
call prec%smoothers_build(a,desc_a,info,amold,vmold,imold)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Error from smoothers build')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
@@ -84,12 +84,8 @@
|
||||
! lowercase strings).
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
! nlev - integer, optional, input.
|
||||
! The number of levels of the multilevel preconditioner.
|
||||
! If nlev is not present and ptype='ML', then nlev=2
|
||||
! is assumed. If ptype /= 'ML', nlev is ignored.
|
||||
!
|
||||
subroutine mld_sprecinit(p,ptype,info,nlev)
|
||||
subroutine mld_sprecinit(prec,ptype,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_prec_mod, mld_protect_name => mld_sprecinit
|
||||
@@ -106,10 +102,9 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
type(mld_sprec_type), intent(inout) :: p
|
||||
class(mld_sprec_type), intent(inout) :: prec
|
||||
character(len=*), intent(in) :: ptype
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: nlev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: nlev_, ilev_
|
||||
@@ -117,97 +112,92 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
|
||||
character(len=*), parameter :: name='mld_precinit'
|
||||
info = psb_success_
|
||||
|
||||
if (allocated(p%precv)) then
|
||||
call mld_precfree(p,info)
|
||||
if (allocated(prec%precv)) then
|
||||
call prec%free(info)
|
||||
if (info /= psb_success_) then
|
||||
! Do we want to do something?
|
||||
endif
|
||||
endif
|
||||
p%coarse_aggr_size = -1
|
||||
prec%coarse_aggr_size = -1
|
||||
|
||||
select case(psb_toupper(ptype(1:len_trim(ptype))))
|
||||
case ('NOPREC','NONE')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_s_base_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_s_base_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_s_id_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_s_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
case ('JAC','DIAG','JACOBI')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_s_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_s_diag_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_s_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
case ('BJAC')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_s_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_s_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
case ('AS')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_s_as_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_s_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_s_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
|
||||
case ('ML')
|
||||
|
||||
if (present(nlev)) then
|
||||
nlev_ = max(1,nlev)
|
||||
p%max_prec_levs = nlev_
|
||||
else
|
||||
nlev_ = p%max_prec_levs
|
||||
end if
|
||||
nlev_ = prec%max_prec_levs
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_s_as_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_s_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_s_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
|
||||
if (nlev_ == 1) return
|
||||
do ilev_ = 2, nlev_ -1
|
||||
allocate(mld_s_as_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(mld_s_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_s_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
end do
|
||||
ilev_ = nlev_
|
||||
allocate(mld_s_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(mld_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
#if defined(HAVE_SLU_)
|
||||
allocate(mld_s_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
allocate(mld_s_slu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
#else
|
||||
allocate(mld_s_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
allocate(mld_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
#endif
|
||||
call p%precv(ilev_)%default()
|
||||
p%precv(ilev_)%parms%coarse_solve = mld_bjac_
|
||||
call p%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
|
||||
call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
|
||||
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
|
||||
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
|
||||
call prec%precv(ilev_)%default()
|
||||
prec%precv(ilev_)%parms%coarse_solve = mld_bjac_
|
||||
call prec%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
|
||||
call prec%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
|
||||
call prec%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
|
||||
call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info)
|
||||
|
||||
thr = 0.05_psb_spk_
|
||||
scale = 1.0_psb_spk_
|
||||
do ilev_=1,nlev_
|
||||
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
|
||||
call p%precv(ilev_)%set(mld_aggr_scale_,scale,info)
|
||||
call p%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info)
|
||||
call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
|
||||
call prec%precv(ilev_)%set(mld_aggr_scale_,scale,info)
|
||||
call prec%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info)
|
||||
end do
|
||||
|
||||
case default
|
||||
|
||||
@@ -72,6 +72,7 @@
|
||||
subroutine mld_z_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_z_inner_mod, mld_protect_name => mld_z_dec_map_bld
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -65,7 +65,7 @@
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
!
|
||||
subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_inner_mod
|
||||
@@ -76,7 +76,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
! Arguments
|
||||
type(psb_zspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_zprec_type),intent(inout),target :: p
|
||||
class(mld_zprec_type),intent(inout),target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!!$ character, intent(in), optional :: upd
|
||||
|
||||
@@ -106,7 +106,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
int_err(1) = 0
|
||||
ictxt = desc_a%get_context()
|
||||
call psb_info(ictxt, me, np)
|
||||
p%ictxt = ictxt
|
||||
prec%ictxt = ictxt
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& 'Entering '
|
||||
@@ -127,7 +127,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
! !$ endif
|
||||
upd_ = 'F'
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
if (.not.allocated(prec%precv)) then
|
||||
!! Error: should have called mld_zprecinit
|
||||
info=3111
|
||||
call psb_errpush(info,name)
|
||||
@@ -138,31 +138,31 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
newsz = -1
|
||||
casize = p%coarse_aggr_size
|
||||
mxplevs = p%max_prec_levs
|
||||
mnaggratio = p%min_aggr_ratio
|
||||
casize = p%coarse_aggr_size
|
||||
iszv = size(p%precv)
|
||||
casize = prec%coarse_aggr_size
|
||||
mxplevs = prec%max_prec_levs
|
||||
mnaggratio = prec%min_aggr_ratio
|
||||
casize = prec%coarse_aggr_size
|
||||
iszv = size(prec%precv)
|
||||
call psb_bcast(ictxt,iszv)
|
||||
call psb_bcast(ictxt,casize)
|
||||
call psb_bcast(ictxt,mxplevs)
|
||||
call psb_bcast(ictxt,mnaggratio)
|
||||
if (casize /= p%coarse_aggr_size) then
|
||||
if (casize /= prec%coarse_aggr_size) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
|
||||
goto 9999
|
||||
end if
|
||||
if (mxplevs /= p%max_prec_levs) then
|
||||
if (mxplevs /= prec%max_prec_levs) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs')
|
||||
goto 9999
|
||||
end if
|
||||
if (mnaggratio /= p%min_aggr_ratio) then
|
||||
if (mnaggratio /= prec%min_aggr_ratio) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio')
|
||||
goto 9999
|
||||
end if
|
||||
if (iszv /= size(p%precv)) then
|
||||
if (iszv /= size(prec%precv)) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent size of precv')
|
||||
goto 9999
|
||||
@@ -182,8 +182,8 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
! This is OK, since it may be called by the user even if there
|
||||
! is only one level
|
||||
!
|
||||
p%precv(1)%base_a => a
|
||||
p%precv(1)%base_desc => desc_a
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -213,13 +213,13 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
end if
|
||||
nplevs = max(itwo,mxplevs)
|
||||
|
||||
coarseparms = p%precv(iszv)%parms
|
||||
baseparms = p%precv(1)%parms
|
||||
medparms = p%precv(2)%parms
|
||||
coarseparms = prec%precv(iszv)%parms
|
||||
baseparms = prec%precv(1)%parms
|
||||
medparms = prec%precv(2)%parms
|
||||
|
||||
call save_smoothers(p%precv(iszv),coarse_sm,coarse_sm2,info)
|
||||
if (info == 0) call save_smoothers(p%precv(2),med_sm,med_sm2,info)
|
||||
if (info == 0) call save_smoothers(p%precv(1),base_sm,base_sm2,info)
|
||||
call save_smoothers(prec%precv(iszv),coarse_sm,coarse_sm2,info)
|
||||
if (info == 0) call save_smoothers(prec%precv(2),med_sm,med_sm2,info)
|
||||
if (info == 0) call save_smoothers(prec%precv(1),base_sm,base_sm2,info)
|
||||
if (info /= psb_success_) then
|
||||
write(0,*) 'Error in saving smoothers',info
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
|
||||
@@ -232,10 +232,10 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
allocate(tprecv(nplevs),stat=info)
|
||||
! First all existing levels
|
||||
if (info == 0) tprecv(1)%parms = baseparms
|
||||
if (info == 0) call restore_smoothers(tprecv(1),p%precv(1)%sm,p%precv(1)%sm2a,info)
|
||||
if (info == 0) call restore_smoothers(tprecv(1),prec%precv(1)%sm,prec%precv(1)%sm2a,info)
|
||||
do i=2, min(iszv,nplevs) - 1
|
||||
if (info == 0) tprecv(i)%parms = medparms
|
||||
if (info == 0) call restore_smoothers(tprecv(i),p%precv(i)%sm,p%precv(i)%sm2a,info)
|
||||
if (info == 0) call restore_smoothers(tprecv(i),prec%precv(i)%sm,prec%precv(i)%sm2a,info)
|
||||
end do
|
||||
! Further intermediates, if any
|
||||
do i=iszv-1, nplevs - 1
|
||||
@@ -252,24 +252,24 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
endif
|
||||
|
||||
do i=1,iszv
|
||||
call p%precv(i)%free(info)
|
||||
call prec%precv(i)%free(info)
|
||||
end do
|
||||
call move_alloc(tprecv,p%precv)
|
||||
iszv = size(p%precv)
|
||||
call move_alloc(tprecv,prec%precv)
|
||||
iszv = size(prec%precv)
|
||||
end if
|
||||
|
||||
!
|
||||
! Finest level first; remember to fix base_a and base_desc
|
||||
!
|
||||
p%precv(1)%base_a => a
|
||||
p%precv(1)%base_desc => desc_a
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
newsz = 0
|
||||
array_build_loop: do i=2, iszv
|
||||
!
|
||||
! Check on the iprcparm contents: they should be the same
|
||||
! on all processes.
|
||||
!
|
||||
call psb_bcast(ictxt,p%precv(i)%parms)
|
||||
call psb_bcast(ictxt,prec%precv(i)%parms)
|
||||
|
||||
!
|
||||
! Sanity checks on the parameters
|
||||
@@ -278,7 +278,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
!
|
||||
! A replicated matrix only makes sense at the coarsest level
|
||||
!
|
||||
call mld_check_def(p%precv(i)%parms%coarse_mat,'Coarse matrix',&
|
||||
call mld_check_def(prec%precv(i)%parms%coarse_mat,'Coarse matrix',&
|
||||
& mld_distr_mat_,is_distr_ml_coarse_mat)
|
||||
end if
|
||||
|
||||
@@ -289,8 +289,8 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
! Build the mapping between levels i-1 and i and the matrix
|
||||
! at level i
|
||||
!
|
||||
if (info == psb_success_) call mld_aggrmap_bld(p%precv(i),&
|
||||
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,&
|
||||
if (info == psb_success_) call mld_aggrmap_bld(prec%precv(i),&
|
||||
& prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
@@ -305,7 +305,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
!
|
||||
! Save op_prol just in case
|
||||
!
|
||||
call op_prol%clone(p%precv(i)%tprol,info)
|
||||
call op_prol%clone(prec%precv(i)%tprol,info)
|
||||
!
|
||||
! Check for early termination of aggregation loop.
|
||||
!
|
||||
@@ -315,9 +315,9 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
if (i==2) then
|
||||
sizeratio = desc_a%get_global_rows()/sizeratio
|
||||
else
|
||||
sizeratio = sum(p%precv(i-1)%map%naggr)/sizeratio
|
||||
sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
|
||||
end if
|
||||
p%precv(i)%szratio = sizeratio
|
||||
prec%precv(i)%szratio = sizeratio
|
||||
if (iaggsize <= casize) then
|
||||
newsz = i
|
||||
end if
|
||||
@@ -334,7 +334,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
end if
|
||||
end if
|
||||
|
||||
if (all(nlaggr == p%precv(i-1)%map%naggr)) then
|
||||
if (all(nlaggr == prec%precv(i-1)%map%naggr)) then
|
||||
newsz=i-1
|
||||
if (me == 0) then
|
||||
write(debug_unit,*) trim(name),&
|
||||
@@ -356,27 +356,27 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
! This is awkward, we are saving the aggregation parms, for the sake
|
||||
! of distr/repl matrix at coarse level. Should be rethought.
|
||||
!
|
||||
athresh = p%precv(newsz)%parms%aggr_thresh
|
||||
ascale = p%precv(newsz)%parms%aggr_scale
|
||||
aomega = p%precv(newsz)%parms%aggr_omega_val
|
||||
if (info == 0) p%precv(newsz)%parms = coarseparms
|
||||
p%precv(newsz)%parms%aggr_thresh = athresh
|
||||
p%precv(newsz)%parms%aggr_scale = ascale
|
||||
p%precv(newsz)%parms%aggr_omega_val = aomega
|
||||
athresh = prec%precv(newsz)%parms%aggr_thresh
|
||||
ascale = prec%precv(newsz)%parms%aggr_scale
|
||||
aomega = prec%precv(newsz)%parms%aggr_omega_val
|
||||
if (info == 0) prec%precv(newsz)%parms = coarseparms
|
||||
prec%precv(newsz)%parms%aggr_thresh = athresh
|
||||
prec%precv(newsz)%parms%aggr_scale = ascale
|
||||
prec%precv(newsz)%parms%aggr_omega_val = aomega
|
||||
|
||||
if (info == 0) call restore_smoothers(p%precv(newsz),coarse_sm,coarse_sm2,info)
|
||||
if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info)
|
||||
if (newsz < i) then
|
||||
!
|
||||
! We are going back and revisit a previous leve;
|
||||
! recover the aggregation.
|
||||
!
|
||||
ilaggr = p%precv(newsz)%map%iaggr
|
||||
nlaggr = p%precv(newsz)%map%naggr
|
||||
call p%precv(newsz)%tprol%clone(op_prol,info)
|
||||
ilaggr = prec%precv(newsz)%map%iaggr
|
||||
nlaggr = prec%precv(newsz)%map%naggr
|
||||
call prec%precv(newsz)%tprol%clone(op_prol,info)
|
||||
end if
|
||||
|
||||
if (info == psb_success_) call mld_lev_mat_asb(p%precv(newsz),&
|
||||
& p%precv(newsz-1)%base_a,p%precv(newsz-1)%base_desc,&
|
||||
if (info == psb_success_) call mld_lev_mat_asb(prec%precv(newsz),&
|
||||
& prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
@@ -385,8 +385,8 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
endif
|
||||
exit array_build_loop
|
||||
else
|
||||
if (info == psb_success_) call mld_lev_mat_asb(p%precv(i),&
|
||||
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,&
|
||||
if (info == psb_success_) call mld_lev_mat_asb(prec%precv(i),&
|
||||
& prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
@@ -409,12 +409,12 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
goto 9999
|
||||
endif
|
||||
do i=1,newsz
|
||||
call p%precv(i)%move_alloc(tprecv(i),info)
|
||||
call prec%precv(i)%move_alloc(tprecv(i),info)
|
||||
end do
|
||||
do i=newsz+1, iszv
|
||||
call p%precv(i)%free(info)
|
||||
call prec%precv(i)%free(info)
|
||||
end do
|
||||
call move_alloc(tprecv,p%precv)
|
||||
call move_alloc(tprecv,prec%precv)
|
||||
! Ignore errors from transfer
|
||||
info = psb_success_
|
||||
!
|
||||
@@ -423,10 +423,10 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
! Fix the pointers, but the level 1 should
|
||||
! be already OK
|
||||
do i=2, iszv
|
||||
p%precv(i)%base_a => p%precv(i)%ac
|
||||
p%precv(i)%base_desc => p%precv(i)%desc_ac
|
||||
p%precv(i)%map%p_desc_X => p%precv(i-1)%base_desc
|
||||
p%precv(i)%map%p_desc_Y => p%precv(i)%base_desc
|
||||
prec%precv(i)%base_a => prec%precv(i)%ac
|
||||
prec%precv(i)%base_desc => prec%precv(i)%desc_ac
|
||||
prec%precv(i)%map%p_desc_X => prec%precv(i-1)%base_desc
|
||||
prec%precv(i)%map%p_desc_Y => prec%precv(i)%base_desc
|
||||
end do
|
||||
end if
|
||||
|
||||
@@ -436,9 +436,9 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
iszv = size(p%precv)
|
||||
iszv = size(prec%precv)
|
||||
|
||||
call p%cmp_complexity()
|
||||
call prec%cmp_complexity()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
|
||||
@@ -1,3 +1,4 @@
|
||||
|
||||
!
|
||||
!
|
||||
! MLD2P4 version 2.1
|
||||
@@ -77,6 +78,7 @@
|
||||
subroutine mld_z_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_z_inner_mod, mld_protect_name => mld_z_lev_aggrmap_bld
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -88,6 +88,7 @@
|
||||
subroutine mld_z_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_z_inner_mod, mld_protect_name => mld_z_lev_aggrmat_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -79,10 +79,10 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
subroutine mld_z_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
subroutine mld_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_inner_mod
|
||||
!use mld_z_inner_mod
|
||||
use mld_z_prec_mod, mld_protect_name => mld_z_smoothers_bld
|
||||
|
||||
Implicit None
|
||||
@@ -90,7 +90,7 @@ subroutine mld_z_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Arguments
|
||||
type(psb_zspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_zprec_type),intent(inout),target :: p
|
||||
class(mld_zprec_type),intent(inout),target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
@@ -140,7 +140,7 @@ subroutine mld_z_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! !$ endif
|
||||
upd_ = 'F'
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
if (.not.allocated(prec%precv)) then
|
||||
!! Error: should have called mld_zprecinit
|
||||
info=3111
|
||||
call psb_errpush(info,name)
|
||||
@@ -150,9 +150,9 @@ subroutine mld_z_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
iszv = size(p%precv)
|
||||
iszv = size(prec%precv)
|
||||
call psb_bcast(ictxt,iszv)
|
||||
if (iszv /= size(p%precv)) then
|
||||
if (iszv /= size(prec%precv)) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent size of precv')
|
||||
goto 9999
|
||||
@@ -174,7 +174,7 @@ subroutine mld_z_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!
|
||||
! build the base preconditioner at level i
|
||||
!
|
||||
call p%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold)
|
||||
call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
write(ch_err,'(a,i7)') 'Error @ level',i
|
||||
|
||||
@@ -88,6 +88,7 @@
|
||||
subroutine mld_zaggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zaggrmap_bld
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -120,6 +120,7 @@
|
||||
subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -84,6 +84,7 @@
|
||||
!
|
||||
subroutine mld_zaggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_biz_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -112,6 +112,7 @@
|
||||
!
|
||||
subroutine mld_zaggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_minnrg_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -100,6 +100,7 @@
|
||||
!
|
||||
subroutine mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_nosmth_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -113,6 +113,7 @@
|
||||
!
|
||||
subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_smth_asb
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -299,6 +299,7 @@
|
||||
subroutine mld_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zmlprec_aply_vect
|
||||
|
||||
implicit none
|
||||
@@ -1303,6 +1304,7 @@ end subroutine mld_zmlprec_aply_vect
|
||||
subroutine mld_zmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_base_prec_type
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zmlprec_aply
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -123,7 +123,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& 'Entering '
|
||||
|
||||
call mld_z_hierarchy_bld(a,desc_a,p,info)
|
||||
call p%hierarchy_build(a,desc_a,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_internal_error_
|
||||
@@ -133,7 +133,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
|
||||
iszv = p%get_nlevs()
|
||||
|
||||
call mld_z_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
call p%smoothers_build(a,desc_a,info,amold,vmold,imold)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_internal_error_
|
||||
|
||||
@@ -75,7 +75,7 @@
|
||||
subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zprecaply
|
||||
use mld_z_inner_mod!, mld_protect_name => mld_zprecaply
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -206,7 +206,7 @@ end subroutine mld_zprecaply
|
||||
subroutine mld_zprecaply1(prec,x,desc_data,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zprecaply1
|
||||
use mld_z_inner_mod!, mld_protect_name => mld_zprecaply1
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -240,7 +240,7 @@ subroutine mld_zprecaply1(prec,x,desc_data,info,trans)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call mld_precaply(prec,x,ww,desc_data,info,trans=trans,work=w1)
|
||||
call prec%apply(x,ww,desc_data,info,trans=trans,work=w1)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precaply')
|
||||
goto 9999
|
||||
@@ -267,7 +267,7 @@ end subroutine mld_zprecaply1
|
||||
subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zprecaply2_vect
|
||||
use mld_z_inner_mod!, mld_protect_name => mld_zprecaply2_vect
|
||||
|
||||
implicit none
|
||||
|
||||
@@ -368,7 +368,7 @@ end subroutine mld_zprecaply2_vect
|
||||
subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_inner_mod, mld_protect_name => mld_zprecaply1_vect
|
||||
use mld_z_inner_mod!, mld_protect_name => mld_zprecaply1_vect
|
||||
|
||||
implicit none
|
||||
|
||||
|
||||
@@ -59,10 +59,9 @@
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
!
|
||||
subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
subroutine mld_zprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_inner_mod
|
||||
use mld_z_prec_mod, mld_protect_name => mld_zprecbld
|
||||
|
||||
Implicit None
|
||||
@@ -70,7 +69,7 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Arguments
|
||||
type(psb_zspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_zprec_type),intent(inout), target :: p
|
||||
class(mld_zprec_type),intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
@@ -100,7 +99,7 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
int_err(1) = 0
|
||||
ictxt = desc_a%get_context()
|
||||
call psb_info(ictxt, me, np)
|
||||
p%ictxt = ictxt
|
||||
prec%ictxt = ictxt
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
@@ -122,7 +121,7 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!!$ endif
|
||||
upd_ = 'F'
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
if (.not.allocated(prec%precv)) then
|
||||
!! Error: should have called mld_zprecinit
|
||||
info=3111
|
||||
call psb_errpush(info,name)
|
||||
@@ -133,9 +132,9 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
newsz = -1
|
||||
iszv = size(p%precv)
|
||||
iszv = size(prec%precv)
|
||||
call psb_bcast(ictxt,iszv)
|
||||
if (iszv /= size(p%precv)) then
|
||||
if (iszv /= size(prec%precv)) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Inconsistent size of precv')
|
||||
goto 9999
|
||||
@@ -157,31 +156,31 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! Check on the iprcparm contents: they should be the same
|
||||
! on all processes.
|
||||
!
|
||||
call psb_bcast(ictxt,p%precv(1)%parms)
|
||||
call psb_bcast(ictxt,prec%precv(1)%parms)
|
||||
|
||||
p%precv(1)%base_a => a
|
||||
p%precv(1)%base_desc => desc_a
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call p%precv(1)%check(info)
|
||||
if (info /= psb_success_) then
|
||||
write(0,*) ' Smoother check error',info
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner check.')
|
||||
goto 9999
|
||||
endif
|
||||
call prec%precv(1)%check(info)
|
||||
if (info /= psb_success_) then
|
||||
write(0,*) ' Smoother check error',info
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner check.')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call p%precv(1)%sm%build(a,desc_a,upd_,info,&
|
||||
& amold=amold,vmold=vmold,imold=imold)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner build.')
|
||||
goto 9999
|
||||
endif
|
||||
call prec%precv(1)%sm%build(a,desc_a,upd_,info,&
|
||||
& amold=amold,vmold=vmold,imold=imold)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='One level preconditioner build.')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
!
|
||||
! Number of levels > 1
|
||||
@@ -190,16 +189,25 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold)
|
||||
!
|
||||
! Build the multilevel preconditioner
|
||||
!
|
||||
call mld_mlprec_bld(a,desc_a,p,info,&
|
||||
& amold=amold,vmold=vmold,imold=imold)
|
||||
call prec%hierarchy_build(a,desc_a,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err='Multilevel preconditioner build.')
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Error from hierarchy build')
|
||||
goto 9999
|
||||
endif
|
||||
end if
|
||||
|
||||
|
||||
call prec%smoothers_build(a,desc_a,info,amold,vmold,imold)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Error from smoothers build')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
@@ -84,12 +84,8 @@
|
||||
! lowercase strings).
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
! nlev - integer, optional, input.
|
||||
! The number of levels of the multilevel preconditioner.
|
||||
! If nlev is not present and ptype='ML', then nlev=2
|
||||
! is assumed. If ptype /= 'ML', nlev is ignored.
|
||||
!
|
||||
subroutine mld_zprecinit(p,ptype,info,nlev)
|
||||
subroutine mld_zprecinit(prec,ptype,info)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_prec_mod, mld_protect_name => mld_zprecinit
|
||||
@@ -109,10 +105,9 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
type(mld_zprec_type), intent(inout) :: p
|
||||
class(mld_zprec_type), intent(inout) :: prec
|
||||
character(len=*), intent(in) :: ptype
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: nlev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: nlev_, ilev_
|
||||
@@ -120,99 +115,94 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
|
||||
character(len=*), parameter :: name='mld_precinit'
|
||||
info = psb_success_
|
||||
|
||||
if (allocated(p%precv)) then
|
||||
call mld_precfree(p,info)
|
||||
if (allocated(prec%precv)) then
|
||||
call prec%free(info)
|
||||
if (info /= psb_success_) then
|
||||
! Do we want to do something?
|
||||
endif
|
||||
endif
|
||||
p%coarse_aggr_size = -1
|
||||
prec%coarse_aggr_size = -1
|
||||
|
||||
select case(psb_toupper(ptype(1:len_trim(ptype))))
|
||||
case ('NOPREC','NONE')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_z_base_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_z_base_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_z_id_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_z_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
case ('JAC','DIAG','JACOBI')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_z_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_z_diag_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_z_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
case ('BJAC')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_z_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_z_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_z_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
case ('AS')
|
||||
nlev_ = 1
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_z_as_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_z_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_z_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_z_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
|
||||
case ('ML')
|
||||
|
||||
if (present(nlev)) then
|
||||
nlev_ = max(1,nlev)
|
||||
p%max_prec_levs = nlev_
|
||||
else
|
||||
nlev_ = p%max_prec_levs
|
||||
end if
|
||||
nlev_ = prec%max_prec_levs
|
||||
ilev_ = 1
|
||||
allocate(p%precv(nlev_),stat=info)
|
||||
allocate(mld_z_as_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(prec%precv(nlev_),stat=info)
|
||||
allocate(mld_z_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_z_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_z_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
|
||||
if (nlev_ == 1) return
|
||||
do ilev_ = 2, nlev_ -1
|
||||
allocate(mld_z_as_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(mld_z_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
allocate(mld_z_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
call p%precv(ilev_)%default()
|
||||
allocate(mld_z_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
call prec%precv(ilev_)%default()
|
||||
|
||||
end do
|
||||
ilev_ = nlev_
|
||||
allocate(mld_z_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
|
||||
allocate(mld_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
|
||||
if (info /= psb_success_) return
|
||||
#if defined(HAVE_UMF_)
|
||||
allocate(mld_z_umf_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
allocate(mld_z_umf_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
#elif defined(HAVE_SLU_)
|
||||
allocate(mld_z_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
allocate(mld_z_slu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
#else
|
||||
allocate(mld_z_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
|
||||
allocate(mld_z_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
|
||||
#endif
|
||||
call p%precv(ilev_)%default()
|
||||
p%precv(ilev_)%parms%coarse_solve = mld_bjac_
|
||||
call p%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
|
||||
call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
|
||||
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
|
||||
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
|
||||
call prec%precv(ilev_)%default()
|
||||
prec%precv(ilev_)%parms%coarse_solve = mld_bjac_
|
||||
call prec%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
|
||||
call prec%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
|
||||
call prec%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
|
||||
call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info)
|
||||
|
||||
thr = 0.05_psb_dpk_
|
||||
scale = 1.0_psb_dpk_
|
||||
do ilev_=1,nlev_
|
||||
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
|
||||
call p%precv(ilev_)%set(mld_aggr_scale_,scale,info)
|
||||
call p%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info)
|
||||
call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
|
||||
call prec%precv(ilev_)%set(mld_aggr_scale_,scale,info)
|
||||
call prec%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info)
|
||||
end do
|
||||
|
||||
case default
|
||||
|
||||
@@ -171,7 +171,7 @@ lib: $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
|
||||
mpobjs:
|
||||
(make $(MPFOBJS) F90="$(MPF90)" F90COPT="$(F90COPT)")
|
||||
(make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)")
|
||||
(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
|
||||
|
||||
veryclean: clean
|
||||
|
||||
@@ -184,7 +184,7 @@ lib: $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
|
||||
mpobjs:
|
||||
(make $(MPFOBJS) F90="$(MPF90)" F90COPT="$(F90COPT)")
|
||||
(make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)")
|
||||
(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
|
||||
|
||||
veryclean: clean
|
||||
|
||||
+21
-18
@@ -46,13 +46,17 @@
|
||||
! The interfaces of the user level routines are defined in mld_prec_mod.f90.
|
||||
!
|
||||
module mld_c_inner_mod
|
||||
use mld_c_prec_type
|
||||
! use mld_c_prec_type, only : mld_c_prec_type
|
||||
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_i_base_vect_type, &
|
||||
& psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_, &
|
||||
& psb_c_vect_type
|
||||
use mld_c_prec_type, only : mld_cprec_type, mld_sml_parms, mld_c_onelev_type
|
||||
|
||||
interface mld_mlprec_bld
|
||||
subroutine mld_cmlprec_bld(a,desc_a,prec,info, amold, vmold,imold)
|
||||
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_i_base_vect_type, &
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_i_base_vect_type, &
|
||||
& psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
|
||||
use mld_c_prec_type, only : mld_cprec_type
|
||||
import :: mld_cprec_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
@@ -61,14 +65,13 @@ module mld_c_inner_mod
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! !$ character, intent(in),optional :: upd
|
||||
end subroutine mld_cmlprec_bld
|
||||
end interface mld_mlprec_bld
|
||||
|
||||
interface mld_mlprec_aply
|
||||
subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
use mld_c_prec_type, only : mld_cprec_type
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: mld_cprec_type
|
||||
implicit none
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_cprec_type), intent(inout) :: p
|
||||
@@ -80,9 +83,9 @@ module mld_c_inner_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine mld_cmlprec_aply
|
||||
subroutine mld_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, &
|
||||
import :: psb_cspmat_type, psb_desc_type, &
|
||||
& psb_spk_, psb_c_vect_type, psb_ipk_
|
||||
use mld_c_prec_type, only : mld_cprec_type
|
||||
import :: mld_cprec_type
|
||||
implicit none
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_cprec_type), intent(inout) :: p
|
||||
@@ -97,8 +100,8 @@ module mld_c_inner_mod
|
||||
|
||||
interface mld_aggrmap_bld
|
||||
subroutine mld_c_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
use mld_c_prec_type, only : mld_c_onelev_type
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: mld_c_onelev_type
|
||||
implicit none
|
||||
type(mld_c_onelev_type), intent(inout), target :: p
|
||||
type(psb_cspmat_type), intent(in) :: a
|
||||
@@ -108,7 +111,7 @@ module mld_c_inner_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine mld_c_lev_aggrmap_bld
|
||||
subroutine mld_caggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: iorder
|
||||
integer(psb_ipk_), intent(in) :: aggr_type
|
||||
@@ -124,7 +127,7 @@ module mld_c_inner_mod
|
||||
|
||||
interface mld_dec_map_bld
|
||||
subroutine mld_c_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
|
||||
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: iorder
|
||||
type(psb_cspmat_type), intent(in) :: a
|
||||
@@ -138,8 +141,8 @@ module mld_c_inner_mod
|
||||
|
||||
interface mld_lev_mat_asb
|
||||
subroutine mld_c_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
use mld_c_prec_type, only : mld_c_onelev_type
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: mld_c_onelev_type
|
||||
implicit none
|
||||
type(mld_c_onelev_type), intent(inout), target :: p
|
||||
type(psb_cspmat_type), intent(in) :: a
|
||||
@@ -152,8 +155,8 @@ module mld_c_inner_mod
|
||||
|
||||
interface mld_aggrmat_asb
|
||||
subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
use mld_c_prec_type, only : mld_sml_parms
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: mld_sml_parms
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -166,8 +169,8 @@ module mld_c_inner_mod
|
||||
|
||||
abstract interface
|
||||
subroutine mld_caggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
use mld_c_prec_type, only : mld_c_onelev_type, mld_sml_parms
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: mld_c_onelev_type, mld_sml_parms
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
|
||||
@@ -435,7 +435,7 @@ contains
|
||||
lv%parms%sweeps = 1
|
||||
lv%parms%sweeps_pre = 1
|
||||
lv%parms%sweeps_post = 1
|
||||
lv%parms%ml_type = mld_mult_ml_
|
||||
lv%parms%ml_type = mld_vcycle_ml_
|
||||
lv%parms%aggr_alg = mld_dec_aggr_
|
||||
lv%parms%aggr_ord = mld_aggr_ord_nat_
|
||||
lv%parms%aggr_kind = mld_smooth_prol_
|
||||
|
||||
@@ -54,53 +54,12 @@ module mld_c_prec_mod
|
||||
use mld_c_ilu_solver
|
||||
use mld_c_gs_solver
|
||||
|
||||
interface mld_precinit
|
||||
subroutine mld_cprecinit(p,ptype,info,nlev)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
|
||||
& mld_cprec_type, psb_ipk_
|
||||
type(mld_cprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: ptype
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: nlev
|
||||
end subroutine mld_cprecinit
|
||||
end interface mld_precinit
|
||||
|
||||
interface mld_precset
|
||||
module procedure mld_c_iprecsetsm, mld_c_iprecsetsv, &
|
||||
& mld_c_iprecseti, mld_c_iprecsetc, mld_c_iprecsetr, &
|
||||
& mld_c_cprecseti, mld_c_cprecsetc, mld_c_cprecsetr
|
||||
end interface mld_precset
|
||||
|
||||
interface mld_precbld
|
||||
subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
|
||||
& psb_c_base_sparse_mat, psb_c_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_cprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_cprecbld
|
||||
end interface mld_precbld
|
||||
|
||||
interface mld_hierarchy_bld
|
||||
subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
|
||||
& mld_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_cprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_c_hierarchy_bld
|
||||
end interface mld_hierarchy_bld
|
||||
|
||||
interface mld_extprol_bld
|
||||
subroutine mld_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
|
||||
@@ -121,23 +80,6 @@ module mld_c_prec_mod
|
||||
end subroutine mld_c_extprol_bld
|
||||
end interface mld_extprol_bld
|
||||
|
||||
interface mld_smoothers_bld
|
||||
subroutine mld_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
|
||||
& psb_c_base_sparse_mat, psb_c_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_cprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_c_smoothers_bld
|
||||
end interface mld_smoothers_bld
|
||||
|
||||
contains
|
||||
|
||||
subroutine mld_c_iprecsetsm(p,val,info,pos)
|
||||
|
||||
+84
-23
@@ -136,6 +136,11 @@ module mld_c_prec_type
|
||||
procedure, pass(prec) :: get_smoother => mld_c_get_smootherp
|
||||
procedure, pass(prec) :: get_solver => mld_c_get_solverp
|
||||
procedure, pass(prec) :: move_alloc => c_prec_move_alloc
|
||||
procedure, pass(prec) :: init => mld_cprecinit
|
||||
procedure, pass(prec) :: build => mld_cprecbld
|
||||
procedure, pass(prec) :: hierarchy_build => mld_c_hierarchy_bld
|
||||
procedure, pass(prec) :: smoothers_build => mld_c_smoothers_bld
|
||||
procedure, pass(prec) :: descr => mld_cfile_prec_descr
|
||||
end type mld_cprec_type
|
||||
|
||||
private :: mld_c_dump, mld_c_get_compl, mld_c_cmp_compl,&
|
||||
@@ -160,7 +165,7 @@ module mld_c_prec_type
|
||||
module procedure mld_cprec_sizeof
|
||||
end interface
|
||||
|
||||
interface mld_precaply
|
||||
interface mld_precapply
|
||||
subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
import :: psb_cspmat_type, psb_desc_type, &
|
||||
& psb_spk_, psb_c_vect_type, mld_cprec_type, psb_ipk_
|
||||
@@ -283,6 +288,63 @@ module mld_c_prec_type
|
||||
end subroutine mld_ccprecsetc
|
||||
end interface
|
||||
|
||||
interface mld_precinit
|
||||
subroutine mld_cprecinit(prec,ptype,info)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
|
||||
& mld_cprec_type, psb_ipk_
|
||||
class(mld_cprec_type), intent(inout) :: prec
|
||||
character(len=*), intent(in) :: ptype
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine mld_cprecinit
|
||||
end interface mld_precinit
|
||||
|
||||
interface mld_precbld
|
||||
subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
|
||||
& psb_c_base_sparse_mat, psb_c_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(mld_cprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_cprecbld
|
||||
end interface mld_precbld
|
||||
|
||||
interface mld_hierarchy_bld
|
||||
subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
|
||||
& mld_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(mld_cprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_c_hierarchy_bld
|
||||
end interface mld_hierarchy_bld
|
||||
|
||||
interface mld_smoothers_bld
|
||||
subroutine mld_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
|
||||
& psb_c_base_sparse_mat, psb_c_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(mld_cprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_c_smoothers_bld
|
||||
end interface mld_smoothers_bld
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -450,16 +512,15 @@ contains
|
||||
! The id of the process printing the message; -1 acts as a wildcard.
|
||||
! Default is psb_root_
|
||||
!
|
||||
subroutine mld_cfile_prec_descr(p,info,iout,root)
|
||||
subroutine mld_cfile_prec_descr(prec,iout,root)
|
||||
implicit none
|
||||
! Arguments
|
||||
type(mld_cprec_type), intent(in) :: p
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(mld_cprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev, nlev, ilmin
|
||||
integer(psb_ipk_) :: ilev, nlev, ilmin, info
|
||||
integer(psb_ipk_) :: ictxt, me, np
|
||||
character(len=20), parameter :: name='mld_file_prec_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
@@ -473,9 +534,9 @@ contains
|
||||
end if
|
||||
if (iout_ < 0) iout_ = 6
|
||||
|
||||
ictxt = p%ictxt
|
||||
ictxt = prec%ictxt
|
||||
|
||||
if (allocated(p%precv)) then
|
||||
if (allocated(prec%precv)) then
|
||||
|
||||
call psb_info(ictxt,me,np)
|
||||
if (present(root)) then
|
||||
@@ -492,9 +553,9 @@ contains
|
||||
! ensured by mld_precbld).
|
||||
!
|
||||
if (me == root_) then
|
||||
nlev = size(p%precv)
|
||||
nlev = size(prec%precv)
|
||||
do ilev = 1, nlev
|
||||
if (.not.allocated(p%precv(ilev)%sm)) then
|
||||
if (.not.allocated(prec%precv(ilev)%sm)) then
|
||||
info = 3111
|
||||
write(iout_,*) ' ',name,&
|
||||
& ': error: inconsistent MLPREC part, should call MLD_PRECINIT'
|
||||
@@ -510,26 +571,26 @@ contains
|
||||
!
|
||||
if (nlev > 1) then
|
||||
write(iout_,*) 'Multilevel Preconditioner'
|
||||
write(iout_,*) 'Outer sweeps:',p%outer_sweeps
|
||||
write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
|
||||
write(iout_,*)
|
||||
write(iout_,*) 'Base preconditioner (smoother) details'
|
||||
endif
|
||||
call p%precv(1)%sm%descr(info,iout=iout_)
|
||||
call prec%precv(1)%sm%descr(info,iout=iout_)
|
||||
if (nlev == 1) then
|
||||
if (p%precv(1)%parms%sweeps > 1) then
|
||||
if (prec%precv(1)%parms%sweeps > 1) then
|
||||
write(iout_,*) ' Number of smoother sweeps : ',&
|
||||
& p%precv(1)%parms%sweeps
|
||||
& prec%precv(1)%parms%sweeps
|
||||
end if
|
||||
write(iout_,*)
|
||||
return
|
||||
end if
|
||||
if (allocated(p%precv(1)%sm2a)) then
|
||||
if (allocated(prec%precv(1)%sm2a)) then
|
||||
write(iout_,*) 'Post smoother details'
|
||||
call p%precv(1)%sm2a%descr(info,iout=iout_)
|
||||
call prec%precv(1)%sm2a%descr(info,iout=iout_)
|
||||
if (nlev == 1) then
|
||||
if (p%precv(1)%parms%sweeps > 1) then
|
||||
if (prec%precv(1)%parms%sweeps > 1) then
|
||||
write(iout_,*) ' Number of smoother sweeps : ',&
|
||||
& p%precv(1)%parms%sweeps
|
||||
& prec%precv(1)%parms%sweeps
|
||||
end if
|
||||
write(iout_,*)
|
||||
return
|
||||
@@ -543,11 +604,11 @@ contains
|
||||
write(iout_,*)
|
||||
write(iout_,*) 'Multilevel details'
|
||||
write(iout_,*) ' Number of levels : ',nlev
|
||||
write(iout_,*) ' Operator complexity: ',p%get_complexity()
|
||||
write(iout_,*) ' Operator complexity: ',prec%get_complexity()
|
||||
ilmin = 2
|
||||
if (nlev == 2) ilmin=1
|
||||
do ilev=ilmin,nlev
|
||||
call p%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
|
||||
call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
|
||||
end do
|
||||
write(iout_,*)
|
||||
|
||||
@@ -656,7 +717,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_cprec_type)
|
||||
call mld_precaply(prec,x,y,desc_data,info,trans,work)
|
||||
call mld_precapply(prec,x,y,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
@@ -686,7 +747,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_cprec_type)
|
||||
call mld_precaply(prec,x,desc_data,info,trans,work)
|
||||
call mld_precapply(prec,x,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
@@ -718,7 +779,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_cprec_type)
|
||||
call mld_precaply(prec,x,y,desc_data,info,trans,work)
|
||||
call mld_precapply(prec,x,y,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
@@ -747,7 +808,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_cprec_type)
|
||||
call mld_precaply(prec,x,desc_data,info,trans)
|
||||
call mld_precapply(prec,x,desc_data,info,trans)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
|
||||
+21
-18
@@ -46,13 +46,17 @@
|
||||
! The interfaces of the user level routines are defined in mld_prec_mod.f90.
|
||||
!
|
||||
module mld_d_inner_mod
|
||||
use mld_d_prec_type
|
||||
! use mld_d_prec_type, only : mld_d_prec_type
|
||||
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_i_base_vect_type, &
|
||||
& psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_, &
|
||||
& psb_d_vect_type
|
||||
use mld_d_prec_type, only : mld_dprec_type, mld_dml_parms, mld_d_onelev_type
|
||||
|
||||
interface mld_mlprec_bld
|
||||
subroutine mld_dmlprec_bld(a,desc_a,prec,info, amold, vmold,imold)
|
||||
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_i_base_vect_type, &
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_i_base_vect_type, &
|
||||
& psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
|
||||
use mld_d_prec_type, only : mld_dprec_type
|
||||
import :: mld_dprec_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
@@ -61,14 +65,13 @@ module mld_d_inner_mod
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! !$ character, intent(in),optional :: upd
|
||||
end subroutine mld_dmlprec_bld
|
||||
end interface mld_mlprec_bld
|
||||
|
||||
interface mld_mlprec_aply
|
||||
subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
use mld_d_prec_type, only : mld_dprec_type
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: mld_dprec_type
|
||||
implicit none
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_dprec_type), intent(inout) :: p
|
||||
@@ -80,9 +83,9 @@ module mld_d_inner_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine mld_dmlprec_aply
|
||||
subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, &
|
||||
import :: psb_dspmat_type, psb_desc_type, &
|
||||
& psb_dpk_, psb_d_vect_type, psb_ipk_
|
||||
use mld_d_prec_type, only : mld_dprec_type
|
||||
import :: mld_dprec_type
|
||||
implicit none
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_dprec_type), intent(inout) :: p
|
||||
@@ -97,8 +100,8 @@ module mld_d_inner_mod
|
||||
|
||||
interface mld_aggrmap_bld
|
||||
subroutine mld_d_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
use mld_d_prec_type, only : mld_d_onelev_type
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: mld_d_onelev_type
|
||||
implicit none
|
||||
type(mld_d_onelev_type), intent(inout), target :: p
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
@@ -108,7 +111,7 @@ module mld_d_inner_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine mld_d_lev_aggrmap_bld
|
||||
subroutine mld_daggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: iorder
|
||||
integer(psb_ipk_), intent(in) :: aggr_type
|
||||
@@ -124,7 +127,7 @@ module mld_d_inner_mod
|
||||
|
||||
interface mld_dec_map_bld
|
||||
subroutine mld_d_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
|
||||
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: iorder
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
@@ -138,8 +141,8 @@ module mld_d_inner_mod
|
||||
|
||||
interface mld_lev_mat_asb
|
||||
subroutine mld_d_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
use mld_d_prec_type, only : mld_d_onelev_type
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: mld_d_onelev_type
|
||||
implicit none
|
||||
type(mld_d_onelev_type), intent(inout), target :: p
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
@@ -152,8 +155,8 @@ module mld_d_inner_mod
|
||||
|
||||
interface mld_aggrmat_asb
|
||||
subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
use mld_d_prec_type, only : mld_dml_parms
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: mld_dml_parms
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -166,8 +169,8 @@ module mld_d_inner_mod
|
||||
|
||||
abstract interface
|
||||
subroutine mld_daggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
use mld_d_prec_type, only : mld_d_onelev_type, mld_dml_parms
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: mld_d_onelev_type, mld_dml_parms
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
|
||||
@@ -435,7 +435,7 @@ contains
|
||||
lv%parms%sweeps = 1
|
||||
lv%parms%sweeps_pre = 1
|
||||
lv%parms%sweeps_post = 1
|
||||
lv%parms%ml_type = mld_mult_ml_
|
||||
lv%parms%ml_type = mld_vcycle_ml_
|
||||
lv%parms%aggr_alg = mld_dec_aggr_
|
||||
lv%parms%aggr_ord = mld_aggr_ord_nat_
|
||||
lv%parms%aggr_kind = mld_smooth_prol_
|
||||
|
||||
@@ -54,53 +54,12 @@ module mld_d_prec_mod
|
||||
use mld_d_ilu_solver
|
||||
use mld_d_gs_solver
|
||||
|
||||
interface mld_precinit
|
||||
subroutine mld_dprecinit(p,ptype,info,nlev)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& mld_dprec_type, psb_ipk_
|
||||
type(mld_dprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: ptype
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: nlev
|
||||
end subroutine mld_dprecinit
|
||||
end interface mld_precinit
|
||||
|
||||
interface mld_precset
|
||||
module procedure mld_d_iprecsetsm, mld_d_iprecsetsv, &
|
||||
& mld_d_iprecseti, mld_d_iprecsetc, mld_d_iprecsetr, &
|
||||
& mld_d_cprecseti, mld_d_cprecsetc, mld_d_cprecsetr
|
||||
end interface mld_precset
|
||||
|
||||
!!$ interface mld_precbld
|
||||
!!$ subroutine mld_dprecbld(a,desc_a,prec,info,upd,amold,vmold,imold)
|
||||
!!$ import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
|
||||
!!$ & psb_d_base_sparse_mat, psb_d_base_vect_type, &
|
||||
!!$ & psb_i_base_vect_type, mld_dprec_type, psb_ipk_
|
||||
!!$ implicit none
|
||||
!!$ type(psb_dspmat_type), intent(in), target :: a
|
||||
!!$ type(psb_desc_type), intent(inout), target :: desc_a
|
||||
!!$ type(mld_dprec_type), intent(inout), target :: prec
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
!!$ class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
!!$ class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
!!$ character, intent(in),optional :: upd
|
||||
!!$ end subroutine mld_dprecbld
|
||||
!!$ end interface mld_precbld
|
||||
!!$
|
||||
interface mld_hierarchy_bld
|
||||
subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& mld_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_dprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_d_hierarchy_bld
|
||||
end interface mld_hierarchy_bld
|
||||
|
||||
interface mld_extprol_bld
|
||||
subroutine mld_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
|
||||
@@ -121,23 +80,6 @@ module mld_d_prec_mod
|
||||
end subroutine mld_d_extprol_bld
|
||||
end interface mld_extprol_bld
|
||||
|
||||
interface mld_smoothers_bld
|
||||
subroutine mld_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& psb_d_base_sparse_mat, psb_d_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_dprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_d_smoothers_bld
|
||||
end interface mld_smoothers_bld
|
||||
|
||||
contains
|
||||
|
||||
subroutine mld_d_iprecsetsm(p,val,info,pos)
|
||||
|
||||
+83
-39
@@ -136,28 +136,16 @@ module mld_d_prec_type
|
||||
procedure, pass(prec) :: get_smoother => mld_d_get_smootherp
|
||||
procedure, pass(prec) :: get_solver => mld_d_get_solverp
|
||||
procedure, pass(prec) :: move_alloc => d_prec_move_alloc
|
||||
procedure, pass(prec) :: init => mld_dprecinit
|
||||
procedure, pass(prec) :: build => mld_dprecbld
|
||||
procedure, pass(prec) :: hierarchy_build => mld_d_hierarchy_bld
|
||||
procedure, pass(prec) :: smoothers_build => mld_d_smoothers_bld
|
||||
procedure, pass(prec) :: descr => mld_dfile_prec_descr
|
||||
end type mld_dprec_type
|
||||
|
||||
private :: mld_d_dump, mld_d_get_compl, mld_d_cmp_compl,&
|
||||
& mld_d_get_nzeros, mld_d_get_nlevs, d_prec_move_alloc
|
||||
|
||||
|
||||
interface mld_precbld
|
||||
subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& psb_d_base_sparse_mat, psb_d_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(mld_dprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine mld_dprecbld
|
||||
end interface mld_precbld
|
||||
|
||||
!
|
||||
! Interfaces to routines for checking the definition of the preconditioner,
|
||||
@@ -177,7 +165,7 @@ module mld_d_prec_type
|
||||
module procedure mld_dprec_sizeof
|
||||
end interface
|
||||
|
||||
interface mld_precaply
|
||||
interface mld_precapply
|
||||
subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
import :: psb_dspmat_type, psb_desc_type, &
|
||||
& psb_dpk_, psb_d_vect_type, mld_dprec_type, psb_ipk_
|
||||
@@ -300,6 +288,63 @@ module mld_d_prec_type
|
||||
end subroutine mld_dcprecsetc
|
||||
end interface
|
||||
|
||||
interface mld_precinit
|
||||
subroutine mld_dprecinit(prec,ptype,info)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& mld_dprec_type, psb_ipk_
|
||||
class(mld_dprec_type), intent(inout) :: prec
|
||||
character(len=*), intent(in) :: ptype
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine mld_dprecinit
|
||||
end interface mld_precinit
|
||||
|
||||
interface mld_precbld
|
||||
subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& psb_d_base_sparse_mat, psb_d_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(mld_dprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_dprecbld
|
||||
end interface mld_precbld
|
||||
|
||||
interface mld_hierarchy_bld
|
||||
subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& mld_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(mld_dprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_d_hierarchy_bld
|
||||
end interface mld_hierarchy_bld
|
||||
|
||||
interface mld_smoothers_bld
|
||||
subroutine mld_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& psb_d_base_sparse_mat, psb_d_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(mld_dprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_d_smoothers_bld
|
||||
end interface mld_smoothers_bld
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -467,16 +512,15 @@ contains
|
||||
! The id of the process printing the message; -1 acts as a wildcard.
|
||||
! Default is psb_root_
|
||||
!
|
||||
subroutine mld_dfile_prec_descr(p,info,iout,root)
|
||||
subroutine mld_dfile_prec_descr(prec,iout,root)
|
||||
implicit none
|
||||
! Arguments
|
||||
type(mld_dprec_type), intent(in) :: p
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(mld_dprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev, nlev, ilmin
|
||||
integer(psb_ipk_) :: ilev, nlev, ilmin, info
|
||||
integer(psb_ipk_) :: ictxt, me, np
|
||||
character(len=20), parameter :: name='mld_file_prec_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
@@ -490,9 +534,9 @@ contains
|
||||
end if
|
||||
if (iout_ < 0) iout_ = 6
|
||||
|
||||
ictxt = p%ictxt
|
||||
ictxt = prec%ictxt
|
||||
|
||||
if (allocated(p%precv)) then
|
||||
if (allocated(prec%precv)) then
|
||||
|
||||
call psb_info(ictxt,me,np)
|
||||
if (present(root)) then
|
||||
@@ -509,9 +553,9 @@ contains
|
||||
! ensured by mld_precbld).
|
||||
!
|
||||
if (me == root_) then
|
||||
nlev = size(p%precv)
|
||||
nlev = size(prec%precv)
|
||||
do ilev = 1, nlev
|
||||
if (.not.allocated(p%precv(ilev)%sm)) then
|
||||
if (.not.allocated(prec%precv(ilev)%sm)) then
|
||||
info = 3111
|
||||
write(iout_,*) ' ',name,&
|
||||
& ': error: inconsistent MLPREC part, should call MLD_PRECINIT'
|
||||
@@ -527,26 +571,26 @@ contains
|
||||
!
|
||||
if (nlev > 1) then
|
||||
write(iout_,*) 'Multilevel Preconditioner'
|
||||
write(iout_,*) 'Outer sweeps:',p%outer_sweeps
|
||||
write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
|
||||
write(iout_,*)
|
||||
write(iout_,*) 'Base preconditioner (smoother) details'
|
||||
endif
|
||||
call p%precv(1)%sm%descr(info,iout=iout_)
|
||||
call prec%precv(1)%sm%descr(info,iout=iout_)
|
||||
if (nlev == 1) then
|
||||
if (p%precv(1)%parms%sweeps > 1) then
|
||||
if (prec%precv(1)%parms%sweeps > 1) then
|
||||
write(iout_,*) ' Number of smoother sweeps : ',&
|
||||
& p%precv(1)%parms%sweeps
|
||||
& prec%precv(1)%parms%sweeps
|
||||
end if
|
||||
write(iout_,*)
|
||||
return
|
||||
end if
|
||||
if (allocated(p%precv(1)%sm2a)) then
|
||||
if (allocated(prec%precv(1)%sm2a)) then
|
||||
write(iout_,*) 'Post smoother details'
|
||||
call p%precv(1)%sm2a%descr(info,iout=iout_)
|
||||
call prec%precv(1)%sm2a%descr(info,iout=iout_)
|
||||
if (nlev == 1) then
|
||||
if (p%precv(1)%parms%sweeps > 1) then
|
||||
if (prec%precv(1)%parms%sweeps > 1) then
|
||||
write(iout_,*) ' Number of smoother sweeps : ',&
|
||||
& p%precv(1)%parms%sweeps
|
||||
& prec%precv(1)%parms%sweeps
|
||||
end if
|
||||
write(iout_,*)
|
||||
return
|
||||
@@ -560,11 +604,11 @@ contains
|
||||
write(iout_,*)
|
||||
write(iout_,*) 'Multilevel details'
|
||||
write(iout_,*) ' Number of levels : ',nlev
|
||||
write(iout_,*) ' Operator complexity: ',p%get_complexity()
|
||||
write(iout_,*) ' Operator complexity: ',prec%get_complexity()
|
||||
ilmin = 2
|
||||
if (nlev == 2) ilmin=1
|
||||
do ilev=ilmin,nlev
|
||||
call p%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
|
||||
call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
|
||||
end do
|
||||
write(iout_,*)
|
||||
|
||||
@@ -673,7 +717,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_dprec_type)
|
||||
call mld_precaply(prec,x,y,desc_data,info,trans,work)
|
||||
call mld_precapply(prec,x,y,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
@@ -703,7 +747,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_dprec_type)
|
||||
call mld_precaply(prec,x,desc_data,info,trans,work)
|
||||
call mld_precapply(prec,x,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
@@ -735,7 +779,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_dprec_type)
|
||||
call mld_precaply(prec,x,y,desc_data,info,trans,work)
|
||||
call mld_precapply(prec,x,y,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
@@ -764,7 +808,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_dprec_type)
|
||||
call mld_precaply(prec,x,desc_data,info,trans)
|
||||
call mld_precapply(prec,x,desc_data,info,trans)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
|
||||
+21
-18
@@ -46,13 +46,17 @@
|
||||
! The interfaces of the user level routines are defined in mld_prec_mod.f90.
|
||||
!
|
||||
module mld_s_inner_mod
|
||||
use mld_s_prec_type
|
||||
! use mld_s_prec_type, only : mld_s_prec_type
|
||||
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_i_base_vect_type, &
|
||||
& psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_, &
|
||||
& psb_s_vect_type
|
||||
use mld_s_prec_type, only : mld_sprec_type, mld_sml_parms, mld_s_onelev_type
|
||||
|
||||
interface mld_mlprec_bld
|
||||
subroutine mld_smlprec_bld(a,desc_a,prec,info, amold, vmold,imold)
|
||||
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_i_base_vect_type, &
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_i_base_vect_type, &
|
||||
& psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
|
||||
use mld_s_prec_type, only : mld_sprec_type
|
||||
import :: mld_sprec_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
@@ -61,14 +65,13 @@ module mld_s_inner_mod
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! !$ character, intent(in),optional :: upd
|
||||
end subroutine mld_smlprec_bld
|
||||
end interface mld_mlprec_bld
|
||||
|
||||
interface mld_mlprec_aply
|
||||
subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
use mld_s_prec_type, only : mld_sprec_type
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: mld_sprec_type
|
||||
implicit none
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_sprec_type), intent(inout) :: p
|
||||
@@ -80,9 +83,9 @@ module mld_s_inner_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine mld_smlprec_aply
|
||||
subroutine mld_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, &
|
||||
import :: psb_sspmat_type, psb_desc_type, &
|
||||
& psb_spk_, psb_s_vect_type, psb_ipk_
|
||||
use mld_s_prec_type, only : mld_sprec_type
|
||||
import :: mld_sprec_type
|
||||
implicit none
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_sprec_type), intent(inout) :: p
|
||||
@@ -97,8 +100,8 @@ module mld_s_inner_mod
|
||||
|
||||
interface mld_aggrmap_bld
|
||||
subroutine mld_s_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
use mld_s_prec_type, only : mld_s_onelev_type
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: mld_s_onelev_type
|
||||
implicit none
|
||||
type(mld_s_onelev_type), intent(inout), target :: p
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
@@ -108,7 +111,7 @@ module mld_s_inner_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine mld_s_lev_aggrmap_bld
|
||||
subroutine mld_saggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: iorder
|
||||
integer(psb_ipk_), intent(in) :: aggr_type
|
||||
@@ -124,7 +127,7 @@ module mld_s_inner_mod
|
||||
|
||||
interface mld_dec_map_bld
|
||||
subroutine mld_s_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
|
||||
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: iorder
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
@@ -138,8 +141,8 @@ module mld_s_inner_mod
|
||||
|
||||
interface mld_lev_mat_asb
|
||||
subroutine mld_s_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
use mld_s_prec_type, only : mld_s_onelev_type
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: mld_s_onelev_type
|
||||
implicit none
|
||||
type(mld_s_onelev_type), intent(inout), target :: p
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
@@ -152,8 +155,8 @@ module mld_s_inner_mod
|
||||
|
||||
interface mld_aggrmat_asb
|
||||
subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
use mld_s_prec_type, only : mld_sml_parms
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: mld_sml_parms
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -166,8 +169,8 @@ module mld_s_inner_mod
|
||||
|
||||
abstract interface
|
||||
subroutine mld_saggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
use mld_s_prec_type, only : mld_s_onelev_type, mld_sml_parms
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: mld_s_onelev_type, mld_sml_parms
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
|
||||
@@ -435,7 +435,7 @@ contains
|
||||
lv%parms%sweeps = 1
|
||||
lv%parms%sweeps_pre = 1
|
||||
lv%parms%sweeps_post = 1
|
||||
lv%parms%ml_type = mld_mult_ml_
|
||||
lv%parms%ml_type = mld_vcycle_ml_
|
||||
lv%parms%aggr_alg = mld_dec_aggr_
|
||||
lv%parms%aggr_ord = mld_aggr_ord_nat_
|
||||
lv%parms%aggr_kind = mld_smooth_prol_
|
||||
|
||||
@@ -54,53 +54,12 @@ module mld_s_prec_mod
|
||||
use mld_s_ilu_solver
|
||||
use mld_s_gs_solver
|
||||
|
||||
interface mld_precinit
|
||||
subroutine mld_sprecinit(p,ptype,info,nlev)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
|
||||
& mld_sprec_type, psb_ipk_
|
||||
type(mld_sprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: ptype
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: nlev
|
||||
end subroutine mld_sprecinit
|
||||
end interface mld_precinit
|
||||
|
||||
interface mld_precset
|
||||
module procedure mld_s_iprecsetsm, mld_s_iprecsetsv, &
|
||||
& mld_s_iprecseti, mld_s_iprecsetc, mld_s_iprecsetr, &
|
||||
& mld_s_cprecseti, mld_s_cprecsetc, mld_s_cprecsetr
|
||||
end interface mld_precset
|
||||
|
||||
interface mld_precbld
|
||||
subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
|
||||
& psb_s_base_sparse_mat, psb_s_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_sprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_sprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_sprecbld
|
||||
end interface mld_precbld
|
||||
|
||||
interface mld_hierarchy_bld
|
||||
subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
|
||||
& mld_sprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_sprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_s_hierarchy_bld
|
||||
end interface mld_hierarchy_bld
|
||||
|
||||
interface mld_extprol_bld
|
||||
subroutine mld_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
|
||||
@@ -121,23 +80,6 @@ module mld_s_prec_mod
|
||||
end subroutine mld_s_extprol_bld
|
||||
end interface mld_extprol_bld
|
||||
|
||||
interface mld_smoothers_bld
|
||||
subroutine mld_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
|
||||
& psb_s_base_sparse_mat, psb_s_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_sprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_sprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_s_smoothers_bld
|
||||
end interface mld_smoothers_bld
|
||||
|
||||
contains
|
||||
|
||||
subroutine mld_s_iprecsetsm(p,val,info,pos)
|
||||
|
||||
+84
-23
@@ -136,6 +136,11 @@ module mld_s_prec_type
|
||||
procedure, pass(prec) :: get_smoother => mld_s_get_smootherp
|
||||
procedure, pass(prec) :: get_solver => mld_s_get_solverp
|
||||
procedure, pass(prec) :: move_alloc => s_prec_move_alloc
|
||||
procedure, pass(prec) :: init => mld_sprecinit
|
||||
procedure, pass(prec) :: build => mld_sprecbld
|
||||
procedure, pass(prec) :: hierarchy_build => mld_s_hierarchy_bld
|
||||
procedure, pass(prec) :: smoothers_build => mld_s_smoothers_bld
|
||||
procedure, pass(prec) :: descr => mld_sfile_prec_descr
|
||||
end type mld_sprec_type
|
||||
|
||||
private :: mld_s_dump, mld_s_get_compl, mld_s_cmp_compl,&
|
||||
@@ -160,7 +165,7 @@ module mld_s_prec_type
|
||||
module procedure mld_sprec_sizeof
|
||||
end interface
|
||||
|
||||
interface mld_precaply
|
||||
interface mld_precapply
|
||||
subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
import :: psb_sspmat_type, psb_desc_type, &
|
||||
& psb_spk_, psb_s_vect_type, mld_sprec_type, psb_ipk_
|
||||
@@ -283,6 +288,63 @@ module mld_s_prec_type
|
||||
end subroutine mld_scprecsetc
|
||||
end interface
|
||||
|
||||
interface mld_precinit
|
||||
subroutine mld_sprecinit(prec,ptype,info)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
|
||||
& mld_sprec_type, psb_ipk_
|
||||
class(mld_sprec_type), intent(inout) :: prec
|
||||
character(len=*), intent(in) :: ptype
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine mld_sprecinit
|
||||
end interface mld_precinit
|
||||
|
||||
interface mld_precbld
|
||||
subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
|
||||
& psb_s_base_sparse_mat, psb_s_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_sprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(mld_sprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_sprecbld
|
||||
end interface mld_precbld
|
||||
|
||||
interface mld_hierarchy_bld
|
||||
subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
|
||||
& mld_sprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(mld_sprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_s_hierarchy_bld
|
||||
end interface mld_hierarchy_bld
|
||||
|
||||
interface mld_smoothers_bld
|
||||
subroutine mld_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
|
||||
& psb_s_base_sparse_mat, psb_s_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_sprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(mld_sprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_s_smoothers_bld
|
||||
end interface mld_smoothers_bld
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -450,16 +512,15 @@ contains
|
||||
! The id of the process printing the message; -1 acts as a wildcard.
|
||||
! Default is psb_root_
|
||||
!
|
||||
subroutine mld_sfile_prec_descr(p,info,iout,root)
|
||||
subroutine mld_sfile_prec_descr(prec,iout,root)
|
||||
implicit none
|
||||
! Arguments
|
||||
type(mld_sprec_type), intent(in) :: p
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(mld_sprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev, nlev, ilmin
|
||||
integer(psb_ipk_) :: ilev, nlev, ilmin, info
|
||||
integer(psb_ipk_) :: ictxt, me, np
|
||||
character(len=20), parameter :: name='mld_file_prec_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
@@ -473,9 +534,9 @@ contains
|
||||
end if
|
||||
if (iout_ < 0) iout_ = 6
|
||||
|
||||
ictxt = p%ictxt
|
||||
ictxt = prec%ictxt
|
||||
|
||||
if (allocated(p%precv)) then
|
||||
if (allocated(prec%precv)) then
|
||||
|
||||
call psb_info(ictxt,me,np)
|
||||
if (present(root)) then
|
||||
@@ -492,9 +553,9 @@ contains
|
||||
! ensured by mld_precbld).
|
||||
!
|
||||
if (me == root_) then
|
||||
nlev = size(p%precv)
|
||||
nlev = size(prec%precv)
|
||||
do ilev = 1, nlev
|
||||
if (.not.allocated(p%precv(ilev)%sm)) then
|
||||
if (.not.allocated(prec%precv(ilev)%sm)) then
|
||||
info = 3111
|
||||
write(iout_,*) ' ',name,&
|
||||
& ': error: inconsistent MLPREC part, should call MLD_PRECINIT'
|
||||
@@ -510,26 +571,26 @@ contains
|
||||
!
|
||||
if (nlev > 1) then
|
||||
write(iout_,*) 'Multilevel Preconditioner'
|
||||
write(iout_,*) 'Outer sweeps:',p%outer_sweeps
|
||||
write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
|
||||
write(iout_,*)
|
||||
write(iout_,*) 'Base preconditioner (smoother) details'
|
||||
endif
|
||||
call p%precv(1)%sm%descr(info,iout=iout_)
|
||||
call prec%precv(1)%sm%descr(info,iout=iout_)
|
||||
if (nlev == 1) then
|
||||
if (p%precv(1)%parms%sweeps > 1) then
|
||||
if (prec%precv(1)%parms%sweeps > 1) then
|
||||
write(iout_,*) ' Number of smoother sweeps : ',&
|
||||
& p%precv(1)%parms%sweeps
|
||||
& prec%precv(1)%parms%sweeps
|
||||
end if
|
||||
write(iout_,*)
|
||||
return
|
||||
end if
|
||||
if (allocated(p%precv(1)%sm2a)) then
|
||||
if (allocated(prec%precv(1)%sm2a)) then
|
||||
write(iout_,*) 'Post smoother details'
|
||||
call p%precv(1)%sm2a%descr(info,iout=iout_)
|
||||
call prec%precv(1)%sm2a%descr(info,iout=iout_)
|
||||
if (nlev == 1) then
|
||||
if (p%precv(1)%parms%sweeps > 1) then
|
||||
if (prec%precv(1)%parms%sweeps > 1) then
|
||||
write(iout_,*) ' Number of smoother sweeps : ',&
|
||||
& p%precv(1)%parms%sweeps
|
||||
& prec%precv(1)%parms%sweeps
|
||||
end if
|
||||
write(iout_,*)
|
||||
return
|
||||
@@ -543,11 +604,11 @@ contains
|
||||
write(iout_,*)
|
||||
write(iout_,*) 'Multilevel details'
|
||||
write(iout_,*) ' Number of levels : ',nlev
|
||||
write(iout_,*) ' Operator complexity: ',p%get_complexity()
|
||||
write(iout_,*) ' Operator complexity: ',prec%get_complexity()
|
||||
ilmin = 2
|
||||
if (nlev == 2) ilmin=1
|
||||
do ilev=ilmin,nlev
|
||||
call p%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
|
||||
call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
|
||||
end do
|
||||
write(iout_,*)
|
||||
|
||||
@@ -656,7 +717,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_sprec_type)
|
||||
call mld_precaply(prec,x,y,desc_data,info,trans,work)
|
||||
call mld_precapply(prec,x,y,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
@@ -686,7 +747,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_sprec_type)
|
||||
call mld_precaply(prec,x,desc_data,info,trans,work)
|
||||
call mld_precapply(prec,x,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
@@ -718,7 +779,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_sprec_type)
|
||||
call mld_precaply(prec,x,y,desc_data,info,trans,work)
|
||||
call mld_precapply(prec,x,y,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
@@ -747,7 +808,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_sprec_type)
|
||||
call mld_precaply(prec,x,desc_data,info,trans)
|
||||
call mld_precapply(prec,x,desc_data,info,trans)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
|
||||
+21
-18
@@ -46,13 +46,17 @@
|
||||
! The interfaces of the user level routines are defined in mld_prec_mod.f90.
|
||||
!
|
||||
module mld_z_inner_mod
|
||||
use mld_z_prec_type
|
||||
! use mld_z_prec_type, only : mld_z_prec_type
|
||||
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_i_base_vect_type, &
|
||||
& psb_dpk_, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_, &
|
||||
& psb_z_vect_type
|
||||
use mld_z_prec_type, only : mld_zprec_type, mld_dml_parms, mld_z_onelev_type
|
||||
|
||||
interface mld_mlprec_bld
|
||||
subroutine mld_zmlprec_bld(a,desc_a,prec,info, amold, vmold,imold)
|
||||
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_i_base_vect_type, &
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_i_base_vect_type, &
|
||||
& psb_dpk_, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
|
||||
use mld_z_prec_type, only : mld_zprec_type
|
||||
import :: mld_zprec_type
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
@@ -61,14 +65,13 @@ module mld_z_inner_mod
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! !$ character, intent(in),optional :: upd
|
||||
end subroutine mld_zmlprec_bld
|
||||
end interface mld_mlprec_bld
|
||||
|
||||
interface mld_mlprec_aply
|
||||
subroutine mld_zmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
use mld_z_prec_type, only : mld_zprec_type
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: mld_zprec_type
|
||||
implicit none
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_zprec_type), intent(inout) :: p
|
||||
@@ -80,9 +83,9 @@ module mld_z_inner_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine mld_zmlprec_aply
|
||||
subroutine mld_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, &
|
||||
import :: psb_zspmat_type, psb_desc_type, &
|
||||
& psb_dpk_, psb_z_vect_type, psb_ipk_
|
||||
use mld_z_prec_type, only : mld_zprec_type
|
||||
import :: mld_zprec_type
|
||||
implicit none
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(mld_zprec_type), intent(inout) :: p
|
||||
@@ -97,8 +100,8 @@ module mld_z_inner_mod
|
||||
|
||||
interface mld_aggrmap_bld
|
||||
subroutine mld_z_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
use mld_z_prec_type, only : mld_z_onelev_type
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: mld_z_onelev_type
|
||||
implicit none
|
||||
type(mld_z_onelev_type), intent(inout), target :: p
|
||||
type(psb_zspmat_type), intent(in) :: a
|
||||
@@ -108,7 +111,7 @@ module mld_z_inner_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine mld_z_lev_aggrmap_bld
|
||||
subroutine mld_zaggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: iorder
|
||||
integer(psb_ipk_), intent(in) :: aggr_type
|
||||
@@ -124,7 +127,7 @@ module mld_z_inner_mod
|
||||
|
||||
interface mld_dec_map_bld
|
||||
subroutine mld_z_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
|
||||
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: iorder
|
||||
type(psb_zspmat_type), intent(in) :: a
|
||||
@@ -138,8 +141,8 @@ module mld_z_inner_mod
|
||||
|
||||
interface mld_lev_mat_asb
|
||||
subroutine mld_z_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
use mld_z_prec_type, only : mld_z_onelev_type
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: mld_z_onelev_type
|
||||
implicit none
|
||||
type(mld_z_onelev_type), intent(inout), target :: p
|
||||
type(psb_zspmat_type), intent(in) :: a
|
||||
@@ -152,8 +155,8 @@ module mld_z_inner_mod
|
||||
|
||||
interface mld_aggrmat_asb
|
||||
subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
use mld_z_prec_type, only : mld_dml_parms
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: mld_dml_parms
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -166,8 +169,8 @@ module mld_z_inner_mod
|
||||
|
||||
abstract interface
|
||||
subroutine mld_zaggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
|
||||
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
use mld_z_prec_type, only : mld_z_onelev_type, mld_dml_parms
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: mld_z_onelev_type, mld_dml_parms
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
|
||||
@@ -435,7 +435,7 @@ contains
|
||||
lv%parms%sweeps = 1
|
||||
lv%parms%sweeps_pre = 1
|
||||
lv%parms%sweeps_post = 1
|
||||
lv%parms%ml_type = mld_mult_ml_
|
||||
lv%parms%ml_type = mld_vcycle_ml_
|
||||
lv%parms%aggr_alg = mld_dec_aggr_
|
||||
lv%parms%aggr_ord = mld_aggr_ord_nat_
|
||||
lv%parms%aggr_kind = mld_smooth_prol_
|
||||
|
||||
@@ -54,53 +54,12 @@ module mld_z_prec_mod
|
||||
use mld_z_ilu_solver
|
||||
use mld_z_gs_solver
|
||||
|
||||
interface mld_precinit
|
||||
subroutine mld_zprecinit(p,ptype,info,nlev)
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& mld_zprec_type, psb_ipk_
|
||||
type(mld_zprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: ptype
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: nlev
|
||||
end subroutine mld_zprecinit
|
||||
end interface mld_precinit
|
||||
|
||||
interface mld_precset
|
||||
module procedure mld_z_iprecsetsm, mld_z_iprecsetsv, &
|
||||
& mld_z_iprecseti, mld_z_iprecsetc, mld_z_iprecsetr, &
|
||||
& mld_z_cprecseti, mld_z_cprecsetc, mld_z_cprecsetr
|
||||
end interface mld_precset
|
||||
|
||||
interface mld_precbld
|
||||
subroutine mld_zprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& psb_z_base_sparse_mat, psb_z_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_zprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_zprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_zprecbld
|
||||
end interface mld_precbld
|
||||
|
||||
interface mld_hierarchy_bld
|
||||
subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& mld_zprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_zprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_z_hierarchy_bld
|
||||
end interface mld_hierarchy_bld
|
||||
|
||||
interface mld_extprol_bld
|
||||
subroutine mld_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
|
||||
@@ -121,23 +80,6 @@ module mld_z_prec_mod
|
||||
end subroutine mld_z_extprol_bld
|
||||
end interface mld_extprol_bld
|
||||
|
||||
interface mld_smoothers_bld
|
||||
subroutine mld_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& psb_z_base_sparse_mat, psb_z_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_zprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(mld_zprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_z_smoothers_bld
|
||||
end interface mld_smoothers_bld
|
||||
|
||||
contains
|
||||
|
||||
subroutine mld_z_iprecsetsm(p,val,info,pos)
|
||||
|
||||
+84
-23
@@ -136,6 +136,11 @@ module mld_z_prec_type
|
||||
procedure, pass(prec) :: get_smoother => mld_z_get_smootherp
|
||||
procedure, pass(prec) :: get_solver => mld_z_get_solverp
|
||||
procedure, pass(prec) :: move_alloc => z_prec_move_alloc
|
||||
procedure, pass(prec) :: init => mld_zprecinit
|
||||
procedure, pass(prec) :: build => mld_zprecbld
|
||||
procedure, pass(prec) :: hierarchy_build => mld_z_hierarchy_bld
|
||||
procedure, pass(prec) :: smoothers_build => mld_z_smoothers_bld
|
||||
procedure, pass(prec) :: descr => mld_zfile_prec_descr
|
||||
end type mld_zprec_type
|
||||
|
||||
private :: mld_z_dump, mld_z_get_compl, mld_z_cmp_compl,&
|
||||
@@ -160,7 +165,7 @@ module mld_z_prec_type
|
||||
module procedure mld_zprec_sizeof
|
||||
end interface
|
||||
|
||||
interface mld_precaply
|
||||
interface mld_precapply
|
||||
subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
|
||||
import :: psb_zspmat_type, psb_desc_type, &
|
||||
& psb_dpk_, psb_z_vect_type, mld_zprec_type, psb_ipk_
|
||||
@@ -283,6 +288,63 @@ module mld_z_prec_type
|
||||
end subroutine mld_zcprecsetc
|
||||
end interface
|
||||
|
||||
interface mld_precinit
|
||||
subroutine mld_zprecinit(prec,ptype,info)
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& mld_zprec_type, psb_ipk_
|
||||
class(mld_zprec_type), intent(inout) :: prec
|
||||
character(len=*), intent(in) :: ptype
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine mld_zprecinit
|
||||
end interface mld_precinit
|
||||
|
||||
interface mld_precbld
|
||||
subroutine mld_zprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& psb_z_base_sparse_mat, psb_z_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_zprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(mld_zprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_zprecbld
|
||||
end interface mld_precbld
|
||||
|
||||
interface mld_hierarchy_bld
|
||||
subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& mld_zprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(mld_zprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_z_hierarchy_bld
|
||||
end interface mld_hierarchy_bld
|
||||
|
||||
interface mld_smoothers_bld
|
||||
subroutine mld_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& psb_z_base_sparse_mat, psb_z_base_vect_type, &
|
||||
& psb_i_base_vect_type, mld_zprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(mld_zprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine mld_z_smoothers_bld
|
||||
end interface mld_smoothers_bld
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -450,16 +512,15 @@ contains
|
||||
! The id of the process printing the message; -1 acts as a wildcard.
|
||||
! Default is psb_root_
|
||||
!
|
||||
subroutine mld_zfile_prec_descr(p,info,iout,root)
|
||||
subroutine mld_zfile_prec_descr(prec,iout,root)
|
||||
implicit none
|
||||
! Arguments
|
||||
type(mld_zprec_type), intent(in) :: p
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(mld_zprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev, nlev, ilmin
|
||||
integer(psb_ipk_) :: ilev, nlev, ilmin, info
|
||||
integer(psb_ipk_) :: ictxt, me, np
|
||||
character(len=20), parameter :: name='mld_file_prec_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
@@ -473,9 +534,9 @@ contains
|
||||
end if
|
||||
if (iout_ < 0) iout_ = 6
|
||||
|
||||
ictxt = p%ictxt
|
||||
ictxt = prec%ictxt
|
||||
|
||||
if (allocated(p%precv)) then
|
||||
if (allocated(prec%precv)) then
|
||||
|
||||
call psb_info(ictxt,me,np)
|
||||
if (present(root)) then
|
||||
@@ -492,9 +553,9 @@ contains
|
||||
! ensured by mld_precbld).
|
||||
!
|
||||
if (me == root_) then
|
||||
nlev = size(p%precv)
|
||||
nlev = size(prec%precv)
|
||||
do ilev = 1, nlev
|
||||
if (.not.allocated(p%precv(ilev)%sm)) then
|
||||
if (.not.allocated(prec%precv(ilev)%sm)) then
|
||||
info = 3111
|
||||
write(iout_,*) ' ',name,&
|
||||
& ': error: inconsistent MLPREC part, should call MLD_PRECINIT'
|
||||
@@ -510,26 +571,26 @@ contains
|
||||
!
|
||||
if (nlev > 1) then
|
||||
write(iout_,*) 'Multilevel Preconditioner'
|
||||
write(iout_,*) 'Outer sweeps:',p%outer_sweeps
|
||||
write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
|
||||
write(iout_,*)
|
||||
write(iout_,*) 'Base preconditioner (smoother) details'
|
||||
endif
|
||||
call p%precv(1)%sm%descr(info,iout=iout_)
|
||||
call prec%precv(1)%sm%descr(info,iout=iout_)
|
||||
if (nlev == 1) then
|
||||
if (p%precv(1)%parms%sweeps > 1) then
|
||||
if (prec%precv(1)%parms%sweeps > 1) then
|
||||
write(iout_,*) ' Number of smoother sweeps : ',&
|
||||
& p%precv(1)%parms%sweeps
|
||||
& prec%precv(1)%parms%sweeps
|
||||
end if
|
||||
write(iout_,*)
|
||||
return
|
||||
end if
|
||||
if (allocated(p%precv(1)%sm2a)) then
|
||||
if (allocated(prec%precv(1)%sm2a)) then
|
||||
write(iout_,*) 'Post smoother details'
|
||||
call p%precv(1)%sm2a%descr(info,iout=iout_)
|
||||
call prec%precv(1)%sm2a%descr(info,iout=iout_)
|
||||
if (nlev == 1) then
|
||||
if (p%precv(1)%parms%sweeps > 1) then
|
||||
if (prec%precv(1)%parms%sweeps > 1) then
|
||||
write(iout_,*) ' Number of smoother sweeps : ',&
|
||||
& p%precv(1)%parms%sweeps
|
||||
& prec%precv(1)%parms%sweeps
|
||||
end if
|
||||
write(iout_,*)
|
||||
return
|
||||
@@ -543,11 +604,11 @@ contains
|
||||
write(iout_,*)
|
||||
write(iout_,*) 'Multilevel details'
|
||||
write(iout_,*) ' Number of levels : ',nlev
|
||||
write(iout_,*) ' Operator complexity: ',p%get_complexity()
|
||||
write(iout_,*) ' Operator complexity: ',prec%get_complexity()
|
||||
ilmin = 2
|
||||
if (nlev == 2) ilmin=1
|
||||
do ilev=ilmin,nlev
|
||||
call p%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
|
||||
call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
|
||||
end do
|
||||
write(iout_,*)
|
||||
|
||||
@@ -656,7 +717,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_zprec_type)
|
||||
call mld_precaply(prec,x,y,desc_data,info,trans,work)
|
||||
call mld_precapply(prec,x,y,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
@@ -686,7 +747,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_zprec_type)
|
||||
call mld_precaply(prec,x,desc_data,info,trans,work)
|
||||
call mld_precapply(prec,x,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
@@ -718,7 +779,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_zprec_type)
|
||||
call mld_precaply(prec,x,y,desc_data,info,trans,work)
|
||||
call mld_precapply(prec,x,y,desc_data,info,trans,work)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
@@ -747,7 +808,7 @@ contains
|
||||
|
||||
select type(prec)
|
||||
type is (mld_zprec_type)
|
||||
call mld_precaply(prec,x,desc_data,info,trans)
|
||||
call mld_precapply(prec,x,desc_data,info,trans)
|
||||
class default
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
|
||||
@@ -15,23 +15,23 @@ EXEDIR=./runs
|
||||
all: mld_sf_sample mld_df_sample mld_cf_sample mld_zf_sample
|
||||
|
||||
mld_df_sample: $(DFSOBJS)
|
||||
$(F90LINK) $(LINKOPT) $(DFSOBJS) -o mld_df_sample \
|
||||
$(FLINK) $(LINKOPT) $(DFSOBJS) -o mld_df_sample \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_df_sample $(EXEDIR)
|
||||
|
||||
|
||||
mld_sf_sample: $(SFSOBJS)
|
||||
$(F90LINK) $(LINKOPT) $(SFSOBJS) -o mld_sf_sample \
|
||||
$(FLINK) $(LINKOPT) $(SFSOBJS) -o mld_sf_sample \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_sf_sample $(EXEDIR)
|
||||
|
||||
mld_cf_sample: $(CFSOBJS)
|
||||
$(F90LINK) $(LINKOPT) $(CFSOBJS) -o mld_cf_sample \
|
||||
$(FLINK) $(LINKOPT) $(CFSOBJS) -o mld_cf_sample \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_cf_sample $(EXEDIR)
|
||||
|
||||
mld_zf_sample: $(ZFSOBJS)
|
||||
$(F90LINK) $(LINKOPT) $(ZFSOBJS) -o mld_zf_sample \
|
||||
$(FLINK) $(LINKOPT) $(ZFSOBJS) -o mld_zf_sample \
|
||||
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_zf_sample $(EXEDIR)
|
||||
|
||||
|
||||
@@ -13,7 +13,7 @@ all: ppde3d
|
||||
|
||||
|
||||
ppde3d: $(PD3DOBJS)
|
||||
$(F90LINK) $(PD3DOBJS) -o ppde3d $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
$(FLINK) $(PD3DOBJS) -o ppde3d $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv ppde3d $(EXEDIR)
|
||||
|
||||
|
||||
|
||||
@@ -11,19 +11,19 @@ EXEDIR=./runs
|
||||
all: mld_s_pde3d mld_d_pde3d mld_s_pde2d mld_d_pde2d
|
||||
|
||||
mld_d_pde3d: mld_d_pde3d.o data_input.o
|
||||
$(F90LINK) mld_d_pde3d.o data_input.o -o mld_d_pde3d $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
$(FLINK) mld_d_pde3d.o data_input.o -o mld_d_pde3d $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_d_pde3d $(EXEDIR)
|
||||
|
||||
mld_s_pde3d: mld_s_pde3d.o data_input.o
|
||||
$(F90LINK) mld_s_pde3d.o data_input.o -o mld_s_pde3d $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
$(FLINK) mld_s_pde3d.o data_input.o -o mld_s_pde3d $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_s_pde3d $(EXEDIR)
|
||||
|
||||
mld_d_pde2d: mld_d_pde2d.o data_input.o
|
||||
$(F90LINK) mld_d_pde2d.o data_input.o -o mld_d_pde2d $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
$(FLINK) mld_d_pde2d.o data_input.o -o mld_d_pde2d $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_d_pde2d $(EXEDIR)
|
||||
|
||||
mld_s_pde2d: mld_s_pde2d.o data_input.o
|
||||
$(F90LINK) mld_s_pde2d.o data_input.o -o mld_s_pde2d $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
$(FLINK) mld_s_pde2d.o data_input.o -o mld_s_pde2d $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
/bin/mv mld_s_pde2d $(EXEDIR)
|
||||
|
||||
mld_d_pde3d.o mld_s_pde3d.o mld_d_pde2d.o mld_s_pde2d.o: data_input.o
|
||||
|
||||
@@ -233,23 +233,23 @@ program mld_d_pde2d
|
||||
! prepare the preconditioner.
|
||||
!
|
||||
if (psb_toupper(prectype%prec) == 'ML') then
|
||||
call mld_precinit(prec,prectype%prec, info)
|
||||
call prec%init(prectype%prec, info)
|
||||
if (prectype%csize>0)&
|
||||
& call mld_precset(prec,'coarse_aggr_size', prectype%csize, info)
|
||||
& call prec%set('coarse_aggr_size', prectype%csize, info)
|
||||
if (prectype%maxlevs>0)&
|
||||
& call mld_precset(prec,'max_prec_levs', prectype%maxlevs, info)
|
||||
& call prec%set('max_prec_levs', prectype%maxlevs, info)
|
||||
if (prectype%mnaggratio>0)&
|
||||
& call mld_precset(prec,'min_aggr_ratio', prectype%mnaggratio, info)
|
||||
& call prec%set('min_aggr_ratio', prectype%mnaggratio, info)
|
||||
if (prectype%athres >= dzero) &
|
||||
& call mld_precset(prec,'aggr_thresh', prectype%athres, info)
|
||||
call mld_precset(prec,'aggr_kind', prectype%aggrkind,info)
|
||||
call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info)
|
||||
call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info)
|
||||
call mld_precset(prec,'aggr_filter', prectype%aggr_filter, info)
|
||||
& call prec%set('aggr_thresh', prectype%athres, info)
|
||||
call prec%set('aggr_kind', prectype%aggrkind,info)
|
||||
call prec%set('aggr_alg', prectype%aggr_alg,info)
|
||||
call prec%set('aggr_ord', prectype%aggr_ord,info)
|
||||
call prec%set('aggr_filter', prectype%aggr_filter, info)
|
||||
|
||||
call psb_barrier(ictxt)
|
||||
t1 = psb_wtime()
|
||||
call mld_hierarchy_bld(a,desc_a,prec,info)
|
||||
call prec%hierarchy_build(a,desc_a,info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_precbld'
|
||||
@@ -259,27 +259,27 @@ program mld_d_pde2d
|
||||
thier = psb_wtime()-t1
|
||||
|
||||
|
||||
call mld_precset(prec,'smoother_type', prectype%smther, info)
|
||||
call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info)
|
||||
call mld_precset(prec,'sub_ovr', prectype%novr, info)
|
||||
call mld_precset(prec,'sub_restr', prectype%restr, info)
|
||||
call mld_precset(prec,'sub_prol', prectype%prol, info)
|
||||
call mld_precset(prec,'sub_solve', prectype%solve, info)
|
||||
call mld_precset(prec,'sub_fillin', prectype%fill1, info)
|
||||
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info)
|
||||
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info)
|
||||
call mld_precset(prec,'ml_type', prectype%mltype, info)
|
||||
call mld_precset(prec,'smoother_pos', prectype%smthpos, info)
|
||||
call mld_precset(prec,'coarse_solve', prectype%csolve, info)
|
||||
call mld_precset(prec,'coarse_subsolve', prectype%csbsolve,info)
|
||||
call mld_precset(prec,'coarse_mat', prectype%cmat, info)
|
||||
call mld_precset(prec,'coarse_fillin', prectype%cfill, info)
|
||||
call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info)
|
||||
call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info)
|
||||
call prec%set('smoother_type', prectype%smther, info)
|
||||
call prec%set('smoother_sweeps', prectype%jsweeps, info)
|
||||
call prec%set('sub_ovr', prectype%novr, info)
|
||||
call prec%set('sub_restr', prectype%restr, info)
|
||||
call prec%set('sub_prol', prectype%prol, info)
|
||||
call prec%set('sub_solve', prectype%solve, info)
|
||||
call prec%set('sub_fillin', prectype%fill1, info)
|
||||
call prec%set('solver_sweeps', prectype%svsweeps, info)
|
||||
call prec%set('sub_iluthrs', prectype%thr1, info)
|
||||
call prec%set('ml_type', prectype%mltype, info)
|
||||
call prec%set('smoother_pos', prectype%smthpos, info)
|
||||
call prec%set('coarse_solve', prectype%csolve, info)
|
||||
call prec%set('coarse_subsolve', prectype%csbsolve,info)
|
||||
call prec%set('coarse_mat', prectype%cmat, info)
|
||||
call prec%set('coarse_fillin', prectype%cfill, info)
|
||||
call prec%set('coarse_iluthrs', prectype%cthres, info)
|
||||
call prec%set('coarse_sweeps', prectype%cjswp, info)
|
||||
|
||||
call psb_barrier(ictxt)
|
||||
t1 = psb_wtime()
|
||||
call mld_smoothers_bld(a,desc_a,prec,info)
|
||||
call prec%smoothers_build(a,desc_a,info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_precbld'
|
||||
@@ -290,19 +290,19 @@ program mld_d_pde2d
|
||||
|
||||
else
|
||||
nlv = 1
|
||||
call mld_precinit(prec,prectype%prec, info)
|
||||
call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info)
|
||||
call mld_precset(prec,'sub_ovr', prectype%novr, info)
|
||||
call mld_precset(prec,'sub_restr', prectype%restr, info)
|
||||
call mld_precset(prec,'sub_prol', prectype%prol, info)
|
||||
call mld_precset(prec,'sub_solve', prectype%solve, info)
|
||||
call mld_precset(prec,'sub_fillin', prectype%fill1, info)
|
||||
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info)
|
||||
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info)
|
||||
call prec%init(prectype%prec, info)
|
||||
call prec%set('smoother_sweeps', prectype%jsweeps, info)
|
||||
call prec%set('sub_ovr', prectype%novr, info)
|
||||
call prec%set('sub_restr', prectype%restr, info)
|
||||
call prec%set('sub_prol', prectype%prol, info)
|
||||
call prec%set('sub_solve', prectype%solve, info)
|
||||
call prec%set('sub_fillin', prectype%fill1, info)
|
||||
call prec%set('solver_sweeps', prectype%svsweeps, info)
|
||||
call prec%set('sub_iluthrs', prectype%thr1, info)
|
||||
call psb_barrier(ictxt)
|
||||
thier = dzero
|
||||
t1 = psb_wtime()
|
||||
call mld_precbld(a,desc_a,prec,info)
|
||||
call prec%build(a,desc_a,info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_precbld'
|
||||
@@ -319,7 +319,7 @@ program mld_d_pde2d
|
||||
|
||||
if (iam == psb_root_) &
|
||||
& write(psb_out_unit,'("Preconditioner time : ",es12.5)') tprec+thier
|
||||
if (iam == psb_root_) call mld_precdescr(prec,info)
|
||||
if (iam == psb_root_) call prec%descr(info)
|
||||
if (iam == psb_root_) &
|
||||
& write(psb_out_unit,'(" ")')
|
||||
|
||||
@@ -378,7 +378,7 @@ program mld_d_pde2d
|
||||
call psb_gefree(b,desc_a,info)
|
||||
call psb_gefree(x,desc_a,info)
|
||||
call psb_spfree(a,desc_a,info)
|
||||
call mld_precfree(prec,info)
|
||||
call prec%free(info)
|
||||
call psb_cdfree(desc_a,info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
|
||||
@@ -245,24 +245,23 @@ program mld_d_pde3d
|
||||
! prepare the preconditioner.
|
||||
!
|
||||
if (psb_toupper(prectype%prec) == 'ML') then
|
||||
call mld_precinit(prec,prectype%prec, info)
|
||||
|
||||
call prec%init(prectype%prec, info)
|
||||
if (prectype%csize>0)&
|
||||
& call mld_precset(prec,'coarse_aggr_size', prectype%csize, info)
|
||||
& call prec%set('coarse_aggr_size', prectype%csize, info)
|
||||
if (prectype%maxlevs>0)&
|
||||
& call mld_precset(prec,'max_prec_levs', prectype%maxlevs, info)
|
||||
& call prec%set('max_prec_levs', prectype%maxlevs, info)
|
||||
if (prectype%mnaggratio>0)&
|
||||
& call mld_precset(prec,'min_aggr_ratio', prectype%mnaggratio, info)
|
||||
& call prec%set('min_aggr_ratio', prectype%mnaggratio, info)
|
||||
if (prectype%athres >= dzero) &
|
||||
& call mld_precset(prec,'aggr_thresh', prectype%athres, info)
|
||||
call mld_precset(prec,'aggr_kind', prectype%aggrkind,info)
|
||||
call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info)
|
||||
call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info)
|
||||
call mld_precset(prec,'aggr_filter', prectype%aggr_filter, info)
|
||||
& call prec%set('aggr_thresh', prectype%athres, info)
|
||||
call prec%set('aggr_kind', prectype%aggrkind,info)
|
||||
call prec%set('aggr_alg', prectype%aggr_alg,info)
|
||||
call prec%set('aggr_ord', prectype%aggr_ord,info)
|
||||
call prec%set('aggr_filter', prectype%aggr_filter, info)
|
||||
|
||||
call psb_barrier(ictxt)
|
||||
t1 = psb_wtime()
|
||||
call mld_hierarchy_bld(a,desc_a,prec,info)
|
||||
call prec%hierarchy_build(a,desc_a,info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_precbld'
|
||||
@@ -272,27 +271,27 @@ program mld_d_pde3d
|
||||
thier = psb_wtime()-t1
|
||||
|
||||
|
||||
call mld_precset(prec,'smoother_type', prectype%smther, info)
|
||||
call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info)
|
||||
call mld_precset(prec,'sub_ovr', prectype%novr, info)
|
||||
call mld_precset(prec,'sub_restr', prectype%restr, info)
|
||||
call mld_precset(prec,'sub_prol', prectype%prol, info)
|
||||
call mld_precset(prec,'sub_solve', prectype%solve, info)
|
||||
call mld_precset(prec,'sub_fillin', prectype%fill1, info)
|
||||
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info)
|
||||
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info)
|
||||
call mld_precset(prec,'ml_type', prectype%mltype, info)
|
||||
call mld_precset(prec,'smoother_pos', prectype%smthpos, info)
|
||||
call mld_precset(prec,'coarse_solve', prectype%csolve, info)
|
||||
call mld_precset(prec,'coarse_subsolve', prectype%csbsolve,info)
|
||||
call mld_precset(prec,'coarse_mat', prectype%cmat, info)
|
||||
call mld_precset(prec,'coarse_fillin', prectype%cfill, info)
|
||||
call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info)
|
||||
call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info)
|
||||
call prec%set('smoother_type', prectype%smther, info)
|
||||
call prec%set('smoother_sweeps', prectype%jsweeps, info)
|
||||
call prec%set('sub_ovr', prectype%novr, info)
|
||||
call prec%set('sub_restr', prectype%restr, info)
|
||||
call prec%set('sub_prol', prectype%prol, info)
|
||||
call prec%set('sub_solve', prectype%solve, info)
|
||||
call prec%set('sub_fillin', prectype%fill1, info)
|
||||
call prec%set('solver_sweeps', prectype%svsweeps, info)
|
||||
call prec%set('sub_iluthrs', prectype%thr1, info)
|
||||
call prec%set('ml_type', prectype%mltype, info)
|
||||
call prec%set('smoother_pos', prectype%smthpos, info)
|
||||
call prec%set('coarse_solve', prectype%csolve, info)
|
||||
call prec%set('coarse_subsolve', prectype%csbsolve,info)
|
||||
call prec%set('coarse_mat', prectype%cmat, info)
|
||||
call prec%set('coarse_fillin', prectype%cfill, info)
|
||||
call prec%set('coarse_iluthrs', prectype%cthres, info)
|
||||
call prec%set('coarse_sweeps', prectype%cjswp, info)
|
||||
|
||||
call psb_barrier(ictxt)
|
||||
t1 = psb_wtime()
|
||||
call mld_smoothers_bld(a,desc_a,prec,info)
|
||||
call prec%smoothers_build(a,desc_a,info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_precbld'
|
||||
@@ -303,19 +302,19 @@ program mld_d_pde3d
|
||||
|
||||
else
|
||||
nlv = 1
|
||||
call mld_precinit(prec,prectype%prec, info)
|
||||
call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info)
|
||||
call mld_precset(prec,'sub_ovr', prectype%novr, info)
|
||||
call mld_precset(prec,'sub_restr', prectype%restr, info)
|
||||
call mld_precset(prec,'sub_prol', prectype%prol, info)
|
||||
call mld_precset(prec,'sub_solve', prectype%solve, info)
|
||||
call mld_precset(prec,'sub_fillin', prectype%fill1, info)
|
||||
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info)
|
||||
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info)
|
||||
call prec%init(prectype%prec, info)
|
||||
call prec%set('smoother_sweeps', prectype%jsweeps, info)
|
||||
call prec%set('sub_ovr', prectype%novr, info)
|
||||
call prec%set('sub_restr', prectype%restr, info)
|
||||
call prec%set('sub_prol', prectype%prol, info)
|
||||
call prec%set('sub_solve', prectype%solve, info)
|
||||
call prec%set('sub_fillin', prectype%fill1, info)
|
||||
call prec%set('solver_sweeps', prectype%svsweeps, info)
|
||||
call prec%set('sub_iluthrs', prectype%thr1, info)
|
||||
call psb_barrier(ictxt)
|
||||
thier = dzero
|
||||
t1 = psb_wtime()
|
||||
call mld_precbld(a,desc_a,prec,info)
|
||||
call prec%build(a,desc_a,info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_precbld'
|
||||
@@ -332,7 +331,7 @@ program mld_d_pde3d
|
||||
|
||||
if (iam == psb_root_) &
|
||||
& write(psb_out_unit,'("Preconditioner time : ",es12.5)') tprec+thier
|
||||
if (iam == psb_root_) call mld_precdescr(prec,info)
|
||||
if (iam == psb_root_) call prec%descr(info)
|
||||
if (iam == psb_root_) &
|
||||
& write(psb_out_unit,'(" ")')
|
||||
|
||||
@@ -391,7 +390,7 @@ program mld_d_pde3d
|
||||
call psb_gefree(b,desc_a,info)
|
||||
call psb_gefree(x,desc_a,info)
|
||||
call psb_spfree(a,desc_a,info)
|
||||
call mld_precfree(prec,info)
|
||||
call prec%free(info)
|
||||
call psb_cdfree(desc_a,info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
|
||||
@@ -18,7 +18,7 @@ SMOOTHED ! Type of aggregation: SMOOTHED, UNSMOOTHED, MINENER
|
||||
DEC ! Type of aggregation: DEC SYMDEC
|
||||
NATURAL ! Ordering of aggregation: NATURAL DEGREE
|
||||
FILTER ! Filtering aggregation: FILTER NOFILTER
|
||||
MULT ! Type of multilevel correction: ADD MULT KCYCLE VCYCLE WCYCLE KCYCLESYM
|
||||
VCYCLE ! Type of multilevel correction: ADD MULT KCYCLE VCYCLE WCYCLE KCYCLESYM
|
||||
TWOSIDE ! Side of correction: PRE POST TWOSIDE (ignored for ADD)
|
||||
4 ! Smoother sweeps
|
||||
BJAC ! Smoother type JACOBI BJAC AS; ignored for non-ML
|
||||
@@ -30,8 +30,8 @@ ILU ! Subdomain solver DSCALE ILU MILU ILUT FWGS BWGS
|
||||
0 ! Level-set N for ILU(N), and P for ILUT
|
||||
1.d-4 ! Threshold T for ILU(T,P)
|
||||
DIST ! Coarse level: matrix distribution DIST REPL
|
||||
SLUDIST ! Coarse level: solver JACOBI BJAC UMF SLU SLUDIST MUMPS
|
||||
SLUDIST ! Coarse level: subsolver DSCALE GS BWGS ILU UMF SLU SLUDIST MUMPS
|
||||
BJAC ! Coarse level: solver JACOBI BJAC UMF SLU SLUDIST MUMPS
|
||||
UMFPACK ! Coarse level: subsolver DSCALE GS BWGS ILU UMF SLU SLUDIST MUMPS
|
||||
1 ! Coarse level: Level-set N for ILU(N)
|
||||
1.d-4 ! Coarse level: Threshold T for ILU(T,P)
|
||||
2 ! Coarse level: Number of Jacobi sweeps
|
||||
|
||||
Reference in New Issue
Block a user