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

mld2p4-fixprec

Browse Source 
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

Fixes to align with psblas3-fixprec
stopcriterion
Salvatore Filippone 8 years ago
parent 0c9b89e3c6
commit b5caffb85d
94 changed files with 4930 additions and 8836 deletions
Show Stats Download Patch File Download Diff File

11270
configure vendored
View File

File diff suppressed because it is too large Load Diff

144
configure.ac
Unescape Escape View File

@ -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!) # 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 # VERSION is the file containing the PSBLAS version code
# FIXME # FIXME
mld2p4_cv_version="2.0" mld2p4_cv_version="2.1"
# A sample source file # A sample source file
AC_CONFIG_SRCDIR([mlprec/mld_prec_type.f90]) AC_CONFIG_SRCDIR([mlprec/mld_prec_type.f90])
@ -119,13 +119,26 @@ case $samplesdir in
esac esac
AC_MSG_RESULT([$INSTALL_DIR $INSTALL_INCLUDEDIR $INSTALL_LIBDIR $INSTALL_DOCSDIR $INSTALL_SAMPLESDIR]) AC_MSG_RESULT([$INSTALL_DIR $INSTALL_INCLUDEDIR $INSTALL_LIBDIR $INSTALL_DOCSDIR $INSTALL_SAMPLESDIR])
############################################################################### dnl
# Compilers detection: FC,F77,CC should be set, if found. 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_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_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 if test "X$CC" == "X" ; then
AC_MSG_ERROR([Problem : No C compiler specified nor found!]) AC_MSG_ERROR([Problem : No C compiler specified nor found!])
fi 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" FDEFINES="$mld_cv_define_prepend-DXLF_10 $FDEFINES"
fi 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. # since (as far as it is known to us) -WF, is not used in earlier versions.
# More problems could be undocumented yet. # More problems could be undocumented yet.
fi fi
@ -153,7 +166,6 @@ PAC_ARG_SERIAL_MPI
if test x"$pac_cv_serial_mpi" == x"yes" ; then if test x"$pac_cv_serial_mpi" == x"yes" ; then
FAKEMPI="fakempi.o"; FAKEMPI="fakempi.o";
MPIFC="$FC"; MPIFC="$FC";
MPIF77="$F77";
MPICC="$CC"; MPICC="$CC";
else else
AC_LANG([C]) AC_LANG([C])
@ -173,23 +185,13 @@ fi
ACX_MPI([], [AC_MSG_ERROR([[Cannot find any suitable MPI implementation for Fortran]])]) 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" ; FC="$MPIFC" ;
F77="$MPIF77";
CC="$MPICC"; CC="$MPICC";
fi fi
# We leave a default language for the next checks.
dnl AC_LANG([Fortran 77])
AC_LANG([C]) 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)! # 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! dnl NOTE : no spaces before the comma, and no brackets before the second argument!
PAC_ARG_WITH_FLAGS(ccopt,CCOPT) PAC_ARG_WITH_FLAGS(ccopt,CCOPT)
PAC_ARG_WITH_FLAGS(fcopt,FCOPT) 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_LIBS
PAC_ARG_WITH_FLAGS(clibs,CLIBS) PAC_ARG_WITH_FLAGS(clibs,CLIBS)
PAC_ARG_WITH_FLAGS(flibs,FLIBS) 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( PAC_CHECK_HAVE_GFORTRAN(
[psblas_cv_fc="gcc"], [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 elif eval "$MPIFC -v 2>&1 | grep NAG 2>/dev/null" ; then
psblas_cv_fc="nag" psblas_cv_fc="nag"
FC="$MPIFC" FC="$MPIFC"
F77="$MPIFC"
else else
psblas_cv_fc="" psblas_cv_fc=""
# unsupported MPI Fortran compiler # unsupported MPI Fortran compiler
@ -282,6 +285,12 @@ PAC_HAVE_MODERN_GFORTRAN(
) )
fi fi
###############################################################################
# Linking, symbol mangling, and misc tests
###############################################################################
# Note : This is functional to Make.inc rules and structure (see below).
AC_LANG([C]) AC_LANG([C])
AC_CHECK_SIZEOF(void *) AC_CHECK_SIZEOF(void *)
# Define for platforms with 64 bit (void * ) pointers # 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" CDEFINES="-DPtr64Bits $CDEFINES"
fi fi
AC_LANG([Fortran]) AC_LANG([Fortran])
if test "X$psblas_cv_fc" == X"pg" ; then
save_FC=$FC
FC=$F77
fi
__AC_FC_NAME_MANGLING __AC_FC_NAME_MANGLING
if test "X$psblas_cv_fc" == X"pg" ; then if test "X$psblas_cv_fc" == X"pg" ; then
FC=$save_FC FC=$save_FC
@ -350,8 +355,10 @@ AC_MSG_RESULT([ $pac_f_c_names ])
############################################################################### ###############################################################################
# Make.inc generation logic # 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$CCOPT" == "X" ; then
if test "X$psblas_cv_fc" == "Xgcc" ; then if test "X$psblas_cv_fc" == "Xgcc" ; then
# note that no space should be placed around the equality symbol in assignements # note that no space should be placed around the equality symbol in assignements
@ -383,6 +390,10 @@ if test "X$CCOPT" == "X" ; then
fi fi
#CFLAGS="${CCOPT}" #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$FCOPT" == "X" ; then
if test "X$psblas_cv_fc" == "Xgcc" ; then if test "X$psblas_cv_fc" == "Xgcc" ; then
# note that no space should be placed around the equality symbol in assignations # note that no space should be placed around the equality symbol in assignations
@ -414,60 +425,24 @@ if test "X$FCOPT" == "X" ; then
fi fi
if test "X$psblas_cv_fc" == X"nag" ; then if test "X$psblas_cv_fc" == X"nag" ; then
# Add needed options # Add needed options
FCOPT="$FCOPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv" 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"
EXTRA_OPT="-mismatch_all" EXTRA_OPT="-mismatch_all"
fi fi
#FCFLAGS="${F90COPT}"
# COPT,FCOPT, F90COPT are aliases for FFLAGS,CFLAGS,FCFLAGS . # COPT,FCOPT are aliases for CFLAGS,FCFLAGS .
############################################################################## ##############################################################################
# Compilers variables selection # Compilers variables selection
############################################################################## ##############################################################################
F90=${FC}
MPF90=${MPIFC}
FC=${FC} FC=${FC}
MPF77=${MPIFC}
CC=${CC} CC=${CC}
MPCC=${MPICC} MPCC=${MPICC}
##############################################################################
# Choice of our compilers, needed by Make.inc
##############################################################################
if test "X$psblas_cv_fc" == X"cray" if test "X$psblas_cv_fc" == X"cray"
then then
MODEXT=".mod" MODEXT=".mod"
@ -495,14 +470,9 @@ fi
# Choice of our compilers, needed by Make.inc # Choice of our compilers, needed by Make.inc
############################################################################## ##############################################################################
if test "X$FLINK" == "X" ; then if test "X$FLINK" == "X" ; then
FLINK=${MPF77} FLINK=${MPF90}
fi
if test "X$F90LINK" == "X" ; then
F90LINK=${MPF90}
fi fi
PAC_FORTRAN_HAVE_PSBLAS([AC_MSG_RESULT([yes.])], PAC_FORTRAN_HAVE_PSBLAS([AC_MSG_RESULT([yes.])],
[AC_MSG_ERROR([no. Could not find working version of PSBLAS.])]) [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".]) AC_MSG_ERROR([PSBLAS patchlevel "$pac_cv_psblas_patchlevel".])
fi fi
if (( $pac_cv_psblas_major < 3 )) || if (( $pac_cv_psblas_major < 3 )) ||
( (( $pac_cv_psblas_major == 3 )) && (( $pac_cv_psblas_minor < 4 ))) ; then ( (( $pac_cv_psblas_major == 3 )) && (( $pac_cv_psblas_minor < 5 ))) ; then
AC_MSG_ERROR([I need at least PSBLAS version 3.4.]) AC_MSG_ERROR([I need at least PSBLAS version 3.5.])
else else
AC_MSG_NOTICE([Am configuring with PSBLAS version $pac_cv_psblas_major.$pac_cv_psblas_minor.$pac_cv_psblas_patchlevel.]) AC_MSG_NOTICE([Am configuring with PSBLAS version $pac_cv_psblas_major.$pac_cv_psblas_minor.$pac_cv_psblas_patchlevel.])
fi fi
@ -702,28 +672,21 @@ if test "x$pac_cv_status_file" != "xNONE"; then
COMPILERULES=''; COMPILERULES='';
else else
COMPILERULES=' COMPILERULES='
F90LINK=$(MPF90) FLINK=$(MPF90)
FLINK=$(MPF77)
# These should be portable rules, arent they? # These should be portable rules, arent they?
.c.o: .c.o:
$(CC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $< -o $@ $(CC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $< -o $@
.f.o:
$(FC) $(FCOPT) $(FINCLUDES) -c $< -o $@
.f90.o: .f90.o:
$(F90) $(FCOPT) $(FINCLUDES) -c $< -o $@ $(FC) $(FCOPT) $(FINCLUDES) -c $< -o $@
.F.o:
$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $< -o $@
.F90.o: .F90.o:
$(F90) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $< -o $@' $(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $< -o $@'
COMPILERULES=" COMPILERULES="
# The following ones are the variables used by the PSBLAS make scripts. # The following ones are the variables used by the PSBLAS make scripts.
F90=$F90
FC=$FC FC=$FC
CC=$CC CC=$CC
F90COPT=$F90COPT
FCOPT=$FCOPT FCOPT=$FCOPT
CCOPT=$CCOPT CCOPT=$CCOPT
FMFLAG=$FMFLAG FMFLAG=$FMFLAG
@ -739,8 +702,7 @@ LIBS=$LIBS
BLAS=$BLAS_LIBS BLAS=$BLAS_LIBS
# These three should be always set! # These three should be always set!
MPF90=$MPF90 MPFC=$MPFC
MPF77=$MPF77
MPCC=$MPCC MPCC=$MPCC
AR=$AR AR=$AR

19
examples/fileread/Makefile
Unescape Escape View File

@ -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_sexample_ml mld_sexample_1lev mld_cexample_ml mld_cexample_1lev
mld_dexample_ml: $(DMOBJS) mld_dexample_ml: $(DMOBJS)
$(F90LINK) $(LINKOPT) $(DMOBJS) -o mld_dexample_ml \ $(FLINK) $(LINKOPT) $(DMOBJS) -o mld_dexample_ml \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_dexample_ml $(EXEDIR) /bin/mv mld_dexample_ml $(EXEDIR)
mld_dexample_1lev: $(D1OBJS) mld_dexample_1lev: $(D1OBJS)
$(F90LINK) $(LINKOPT) $(D1OBJS) -o mld_dexample_1lev \ $(FLINK) $(LINKOPT) $(D1OBJS) -o mld_dexample_1lev \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_dexample_1lev $(EXEDIR) /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_dexample_1lev.o: data_input.o
mld_zexample_ml: $(ZMOBJS) mld_zexample_ml: $(ZMOBJS)
$(F90LINK) $(LINKOPT) $(ZMOBJS) -o mld_zexample_ml \ $(FLINK) $(LINKOPT) $(ZMOBJS) -o mld_zexample_ml \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_zexample_ml $(EXEDIR) /bin/mv mld_zexample_ml $(EXEDIR)
mld_zexample_1lev: $(Z1OBJS) mld_zexample_1lev: $(Z1OBJS)
$(F90LINK) $(LINKOPT) $(Z1OBJS) -o mld_zexample_1lev \ $(FLINK) $(LINKOPT) $(Z1OBJS) -o mld_zexample_1lev \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_zexample_1lev $(EXEDIR) /bin/mv mld_zexample_1lev $(EXEDIR)
@ -48,12 +48,12 @@ mld_zexample_1lev.o: data_input.o
mld_sexample_ml: $(SMOBJS) mld_sexample_ml: $(SMOBJS)
$(F90LINK) $(LINKOPT) $(SMOBJS) -o mld_sexample_ml \ $(FLINK) $(LINKOPT) $(SMOBJS) -o mld_sexample_ml \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_sexample_ml $(EXEDIR) /bin/mv mld_sexample_ml $(EXEDIR)
mld_sexample_1lev: $(S1OBJS) mld_sexample_1lev: $(S1OBJS)
$(F90LINK) $(LINKOPT) $(S1OBJS) -o mld_sexample_1lev \ $(FLINK) $(LINKOPT) $(S1OBJS) -o mld_sexample_1lev \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_sexample_1lev $(EXEDIR) /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_sexample_1lev.o: data_input.o
mld_cexample_ml: $(CMOBJS) mld_cexample_ml: $(CMOBJS)
$(F90LINK) $(LINKOPT) $(CMOBJS) -o mld_cexample_ml \ $(FLINK) $(LINKOPT) $(CMOBJS) -o mld_cexample_ml \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_cexample_ml $(EXEDIR) /bin/mv mld_cexample_ml $(EXEDIR)
mld_cexample_1lev: $(C1OBJS) mld_cexample_1lev: $(C1OBJS)
$(F90LINK) $(LINKOPT) $(C1OBJS) -o mld_cexample_1lev \ $(FLINK) $(LINKOPT) $(C1OBJS) -o mld_cexample_1lev \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_cexample_1lev $(EXEDIR) /bin/mv mld_cexample_1lev $(EXEDIR)
@ -74,9 +74,6 @@ mld_cexample_ml.o: data_input.o
mld_cexample_1lev.o: data_input.o mld_cexample_1lev.o: data_input.o
.f90.o:
$(MPF90) $(F90COPT) $(FINCLUDES) -c $<
clean: clean:
/bin/rm -f *$(.mod) \ /bin/rm -f *$(.mod) \
$(DMOBJS) $(D1OBJS) $(ZMOBJS) $(Z1OBJS) \ $(DMOBJS) $(D1OBJS) $(ZMOBJS) $(Z1OBJS) \

11
examples/pdegen/Makefile
Unescape Escape View File

@ -16,12 +16,12 @@ all: mld_sexample_ml mld_sexample_1lev mld_dexample_ml mld_dexample_1lev
mld_dexample_ml: $(DMOBJS) mld_dexample_ml: $(DMOBJS)
$(F90LINK) $(LINKOPT) $(DMOBJS) -o mld_dexample_ml \ $(FLINK) $(LINKOPT) $(DMOBJS) -o mld_dexample_ml \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_dexample_ml $(EXEDIR) /bin/mv mld_dexample_ml $(EXEDIR)
mld_dexample_1lev: $(D1OBJS) mld_dexample_1lev: $(D1OBJS)
$(F90LINK) $(LINKOPT) $(D1OBJS) -o mld_dexample_1lev \ $(FLINK) $(LINKOPT) $(D1OBJS) -o mld_dexample_1lev \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_dexample_1lev $(EXEDIR) /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_dexample_1lev.o: data_input.o
mld_sexample_ml: $(SMOBJS) mld_sexample_ml: $(SMOBJS)
$(F90LINK) $(LINKOPT) $(SMOBJS) -o mld_sexample_ml \ $(FLINK) $(LINKOPT) $(SMOBJS) -o mld_sexample_ml \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_sexample_ml $(EXEDIR) /bin/mv mld_sexample_ml $(EXEDIR)
mld_sexample_1lev: $(S1OBJS) mld_sexample_1lev: $(S1OBJS)
$(F90LINK) $(LINKOPT) $(S1OBJS) -o mld_sexample_1lev \ $(FLINK) $(LINKOPT) $(S1OBJS) -o mld_sexample_1lev \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_sexample_1lev $(EXEDIR) /bin/mv mld_sexample_1lev $(EXEDIR)
mld_sexample_ml.o: data_input.o mld_sexample_ml.o: data_input.o
mld_sexample_1lev.o: data_input.o mld_sexample_1lev.o: data_input.o
.f90.o:
$(MPF90) $(F90COPT) $(FINCLUDES) -c $<
clean: clean:
/bin/rm -f $(DMOBJS) $(D1OBJS) $(SMOBJS) $(S1OBJS) \ /bin/rm -f $(DMOBJS) $(D1OBJS) $(SMOBJS) $(S1OBJS) \
*$(.mod) $(EXEDIR)/mld_dexample_ml $(EXEDIR)/mld_dexample_1lev\ *$(.mod) $(EXEDIR)/mld_dexample_ml $(EXEDIR)/mld_dexample_1lev\

2
mlprec/impl/Makefile
Unescape Escape View File

@ -82,7 +82,7 @@ solvd:
cd solver && $(MAKE) cd solver && $(MAKE)
mpobjs: mpobjs:
(make $(MPFOBJS) F90="$(MPF90)" F90COPT="$(F90COPT)") (make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)")
(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)") (make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
veryclean: clean veryclean: clean

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

@ -71,7 +71,7 @@ lib: $(OBJS)
$(RANLIB) $(HERE)/$(LIBNAME) $(RANLIB) $(HERE)/$(LIBNAME)
mpobjs: mpobjs:
(make $(MPFOBJS) F90="$(MPF90)" F90COPT="$(F90COPT)") (make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)")
(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)") (make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
veryclean: clean veryclean: clean

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

@ -72,6 +72,7 @@
subroutine mld_c_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) subroutine mld_c_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_c_inner_mod, mld_protect_name => mld_c_dec_map_bld use mld_c_inner_mod, mld_protect_name => mld_c_dec_map_bld
implicit none implicit none

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

@ -65,7 +65,7 @@
! info - integer, output. ! info - integer, output.
! Error code. ! 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 psb_base_mod
use mld_c_inner_mod use mld_c_inner_mod
@ -76,7 +76,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
! Arguments ! Arguments
type(psb_cspmat_type),intent(in), target :: a type(psb_cspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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 integer(psb_ipk_), intent(out) :: info
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
@ -106,7 +106,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
int_err(1) = 0 int_err(1) = 0
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
p%ictxt = ictxt prec%ictxt = ictxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
@ -127,7 +127,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
! !$ endif ! !$ endif
upd_ = 'F' upd_ = 'F'
if (.not.allocated(p%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_cprecinit !! Error: should have called mld_cprecinit
info=3111 info=3111
call psb_errpush(info,name) 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 ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
casize = p%coarse_aggr_size casize = prec%coarse_aggr_size
mxplevs = p%max_prec_levs mxplevs = prec%max_prec_levs
mnaggratio = p%min_aggr_ratio mnaggratio = prec%min_aggr_ratio
casize = p%coarse_aggr_size casize = prec%coarse_aggr_size
iszv = size(p%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ictxt,mnaggratio)
if (casize /= p%coarse_aggr_size) then if (casize /= prec%coarse_aggr_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
goto 9999 goto 9999
end if end if
if (mxplevs /= p%max_prec_levs) then if (mxplevs /= prec%max_prec_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') call psb_errpush(info,name,a_err='Inconsistent max_prec_levs')
goto 9999 goto 9999
end if end if
if (mnaggratio /= p%min_aggr_ratio) then if (mnaggratio /= prec%min_aggr_ratio) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio')
goto 9999 goto 9999
end if end if
if (iszv /= size(p%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999 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 ! This is OK, since it may be called by the user even if there
! is only one level ! is only one level
! !
p%precv(1)%base_a => a prec%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -213,13 +213,13 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
end if end if
nplevs = max(itwo,mxplevs) nplevs = max(itwo,mxplevs)
coarseparms = p%precv(iszv)%parms coarseparms = prec%precv(iszv)%parms
baseparms = p%precv(1)%parms baseparms = prec%precv(1)%parms
medparms = p%precv(2)%parms medparms = prec%precv(2)%parms
call save_smoothers(p%precv(iszv),coarse_sm,coarse_sm2,info) call save_smoothers(prec%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(prec%precv(2),med_sm,med_sm2,info)
if (info == 0) call save_smoothers(p%precv(1),base_sm,base_sm2,info) if (info == 0) call save_smoothers(prec%precv(1),base_sm,base_sm2,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) 'Error in saving smoothers',info write(0,*) 'Error in saving smoothers',info
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') 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) allocate(tprecv(nplevs),stat=info)
! First all existing levels ! First all existing levels
if (info == 0) tprecv(1)%parms = baseparms 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 do i=2, min(iszv,nplevs) - 1
if (info == 0) tprecv(i)%parms = medparms 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 end do
! Further intermediates, if any ! Further intermediates, if any
do i=iszv-1, nplevs - 1 do i=iszv-1, nplevs - 1
@ -252,24 +252,24 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
endif endif
do i=1,iszv do i=1,iszv
call p%precv(i)%free(info) call prec%precv(i)%free(info)
end do end do
call move_alloc(tprecv,p%precv) call move_alloc(tprecv,prec%precv)
iszv = size(p%precv) iszv = size(prec%precv)
end if end if
! !
! Finest level first; remember to fix base_a and base_desc ! Finest level first; remember to fix base_a and base_desc
! !
p%precv(1)%base_a => a prec%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
newsz = 0 newsz = 0
array_build_loop: do i=2, iszv array_build_loop: do i=2, iszv
! !
! Check on the iprcparm contents: they should be the same ! Check on the iprcparm contents: they should be the same
! on all processes. ! on all processes.
! !
call psb_bcast(ictxt,p%precv(i)%parms) call psb_bcast(ictxt,prec%precv(i)%parms)
! !
! Sanity checks on the parameters ! 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 ! 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) & mld_distr_mat_,is_distr_ml_coarse_mat)
end if 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 ! Build the mapping between levels i-1 and i and the matrix
! at level i ! at level i
! !
if (info == psb_success_) call mld_aggrmap_bld(p%precv(i),& if (info == psb_success_) call mld_aggrmap_bld(prec%precv(i),&
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then 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 ! 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. ! 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 if (i==2) then
sizeratio = desc_a%get_global_rows()/sizeratio sizeratio = desc_a%get_global_rows()/sizeratio
else else
sizeratio = sum(p%precv(i-1)%map%naggr)/sizeratio sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
end if end if
p%precv(i)%szratio = sizeratio prec%precv(i)%szratio = sizeratio
if (iaggsize <= casize) then if (iaggsize <= casize) then
newsz = i newsz = i
end if end if
@ -334,7 +334,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
end if end if
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 newsz=i-1
if (me == 0) then if (me == 0) then
write(debug_unit,*) trim(name),& 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 ! This is awkward, we are saving the aggregation parms, for the sake
! of distr/repl matrix at coarse level. Should be rethought. ! of distr/repl matrix at coarse level. Should be rethought.
! !
athresh = p%precv(newsz)%parms%aggr_thresh athresh = prec%precv(newsz)%parms%aggr_thresh
ascale = p%precv(newsz)%parms%aggr_scale ascale = prec%precv(newsz)%parms%aggr_scale
aomega = p%precv(newsz)%parms%aggr_omega_val aomega = prec%precv(newsz)%parms%aggr_omega_val
if (info == 0) p%precv(newsz)%parms = coarseparms if (info == 0) prec%precv(newsz)%parms = coarseparms
p%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_thresh = athresh
p%precv(newsz)%parms%aggr_scale = ascale prec%precv(newsz)%parms%aggr_scale = ascale
p%precv(newsz)%parms%aggr_omega_val = aomega 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 if (newsz < i) then
! !
! We are going back and revisit a previous leve; ! We are going back and revisit a previous leve;
! recover the aggregation. ! recover the aggregation.
! !
ilaggr = p%precv(newsz)%map%iaggr ilaggr = prec%precv(newsz)%map%iaggr
nlaggr = p%precv(newsz)%map%naggr nlaggr = prec%precv(newsz)%map%naggr
call p%precv(newsz)%tprol%clone(op_prol,info) call prec%precv(newsz)%tprol%clone(op_prol,info)
end if end if
if (info == psb_success_) call mld_lev_mat_asb(p%precv(newsz),& if (info == psb_success_) call mld_lev_mat_asb(prec%precv(newsz),&
& p%precv(newsz-1)%base_a,p%precv(newsz-1)%base_desc,& & prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,&
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
@ -385,8 +385,8 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
endif endif
exit array_build_loop exit array_build_loop
else else
if (info == psb_success_) call mld_lev_mat_asb(p%precv(i),& if (info == psb_success_) call mld_lev_mat_asb(prec%precv(i),&
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
@ -409,12 +409,12 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
goto 9999 goto 9999
endif endif
do i=1,newsz do i=1,newsz
call p%precv(i)%move_alloc(tprecv(i),info) call prec%precv(i)%move_alloc(tprecv(i),info)
end do end do
do i=newsz+1, iszv do i=newsz+1, iszv
call p%precv(i)%free(info) call prec%precv(i)%free(info)
end do end do
call move_alloc(tprecv,p%precv) call move_alloc(tprecv,prec%precv)
! Ignore errors from transfer ! Ignore errors from transfer
info = psb_success_ 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 ! Fix the pointers, but the level 1 should
! be already OK ! be already OK
do i=2, iszv do i=2, iszv
p%precv(i)%base_a => p%precv(i)%ac prec%precv(i)%base_a => prec%precv(i)%ac
p%precv(i)%base_desc => p%precv(i)%desc_ac prec%precv(i)%base_desc => prec%precv(i)%desc_ac
p%precv(i)%map%p_desc_X => p%precv(i-1)%base_desc prec%precv(i)%map%p_desc_X => prec%precv(i-1)%base_desc
p%precv(i)%map%p_desc_Y => p%precv(i)%base_desc prec%precv(i)%map%p_desc_Y => prec%precv(i)%base_desc
end do end do
end if end if
@ -436,9 +436,9 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info)
goto 9999 goto 9999
endif endif
iszv = size(p%precv) iszv = size(prec%precv)
call p%cmp_complexity() call prec%cmp_complexity()
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&

2
mlprec/impl/mld_c_lev_aggrmap_bld.f90
Unescape Escape View File

@ -1,3 +1,4 @@
! !
! !
! MLD2P4 version 2.1 ! MLD2P4 version 2.1
@ -77,6 +78,7 @@
subroutine mld_c_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info) subroutine mld_c_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_c_inner_mod, mld_protect_name => mld_c_lev_aggrmap_bld use mld_c_inner_mod, mld_protect_name => mld_c_lev_aggrmap_bld
implicit none implicit none

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

@ -88,6 +88,7 @@
subroutine mld_c_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) subroutine mld_c_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_c_inner_mod, mld_protect_name => mld_c_lev_aggrmat_asb use mld_c_inner_mod, mld_protect_name => mld_c_lev_aggrmat_asb
implicit none implicit none

14
mlprec/impl/mld_c_smoothers_bld.f90
Unescape Escape View File

@ -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 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 use mld_c_prec_mod, mld_protect_name => mld_c_smoothers_bld
Implicit None Implicit None
@ -90,7 +90,7 @@ subroutine mld_c_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
! Arguments ! Arguments
type(psb_cspmat_type),intent(in), target :: a type(psb_cspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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 integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold 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 ! !$ endif
upd_ = 'F' upd_ = 'F'
if (.not.allocated(p%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_cprecinit !! Error: should have called mld_cprecinit
info=3111 info=3111
call psb_errpush(info,name) 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 ! Check to ensure all procs have the same
! !
iszv = size(p%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999 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 ! 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 if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Error @ level',i write(ch_err,'(a,i7)') 'Error @ level',i

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

@ -88,6 +88,7 @@
subroutine mld_caggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info) subroutine mld_caggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_c_inner_mod, mld_protect_name => mld_caggrmap_bld use mld_c_inner_mod, mld_protect_name => mld_caggrmap_bld
implicit none implicit none

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

@ -120,6 +120,7 @@
subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_c_inner_mod, mld_protect_name => mld_caggrmat_asb use mld_c_inner_mod, mld_protect_name => mld_caggrmat_asb
implicit none implicit none

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

@ -84,6 +84,7 @@
! !
subroutine mld_caggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_caggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_c_inner_mod, mld_protect_name => mld_caggrmat_biz_asb use mld_c_inner_mod, mld_protect_name => mld_caggrmat_biz_asb
implicit none implicit none

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

@ -112,6 +112,7 @@
! !
subroutine mld_caggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_caggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_c_inner_mod, mld_protect_name => mld_caggrmat_minnrg_asb use mld_c_inner_mod, mld_protect_name => mld_caggrmat_minnrg_asb
implicit none implicit none

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

@ -100,6 +100,7 @@
! !
subroutine mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_c_inner_mod, mld_protect_name => mld_caggrmat_nosmth_asb use mld_c_inner_mod, mld_protect_name => mld_caggrmat_nosmth_asb
implicit none implicit none

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

@ -113,6 +113,7 @@
! !
subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_c_inner_mod, mld_protect_name => mld_caggrmat_smth_asb use mld_c_inner_mod, mld_protect_name => mld_caggrmat_smth_asb
implicit none implicit none

2
mlprec/impl/mld_cmlprec_aply.f90
Unescape Escape View File

@ -299,6 +299,7 @@
subroutine mld_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) subroutine mld_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_c_inner_mod, mld_protect_name => mld_cmlprec_aply_vect use mld_c_inner_mod, mld_protect_name => mld_cmlprec_aply_vect
implicit none 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) subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_c_inner_mod, mld_protect_name => mld_cmlprec_aply use mld_c_inner_mod, mld_protect_name => mld_cmlprec_aply
implicit none implicit none

4
mlprec/impl/mld_cmlprec_bld.f90
Unescape Escape View File

@ -123,7 +123,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
call mld_c_hierarchy_bld(a,desc_a,p,info) call p%hierarchy_build(a,desc_a,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_internal_error_ 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() 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 if (info /= psb_success_) then
info=psb_err_internal_error_ info=psb_err_internal_error_

10
mlprec/impl/mld_cprecaply.f90
Unescape Escape View File

@ -75,7 +75,7 @@
subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work) subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod 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 implicit none
@ -206,7 +206,7 @@ end subroutine mld_cprecaply
subroutine mld_cprecaply1(prec,x,desc_data,info,trans) subroutine mld_cprecaply1(prec,x,desc_data,info,trans)
use psb_base_mod 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 implicit none
@ -240,7 +240,7 @@ subroutine mld_cprecaply1(prec,x,desc_data,info,trans)
goto 9999 goto 9999
end if 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 if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precaply') call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precaply')
goto 9999 goto 9999
@ -267,7 +267,7 @@ end subroutine mld_cprecaply1
subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work) subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
use psb_base_mod 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 implicit none
@ -368,7 +368,7 @@ end subroutine mld_cprecaply2_vect
subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
use psb_base_mod 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 implicit none

70
mlprec/impl/mld_cprecbld.f90
Unescape Escape View File

@ -59,10 +59,9 @@
! info - integer, output. ! info - integer, output.
! Error code. ! 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 psb_base_mod
use mld_c_inner_mod
use mld_c_prec_mod, mld_protect_name => mld_cprecbld use mld_c_prec_mod, mld_protect_name => mld_cprecbld
Implicit None Implicit None
@ -70,7 +69,7 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold)
! Arguments ! Arguments
type(psb_cspmat_type),intent(in), target :: a type(psb_cspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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 integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold 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 int_err(1) = 0
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
p%ictxt = ictxt prec%ictxt = ictxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -122,7 +121,7 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold)
!!$ endif !!$ endif
upd_ = 'F' upd_ = 'F'
if (.not.allocated(p%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_cprecinit !! Error: should have called mld_cprecinit
info=3111 info=3111
call psb_errpush(info,name) 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 ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
iszv = size(p%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999 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 ! Check on the iprcparm contents: they should be the same
! on all processes. ! 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 prec%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
goto 9999 goto 9999
end if end if
call p%precv(1)%check(info) call prec%precv(1)%check(info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) ' Smoother check error',info write(0,*) ' Smoother check error',info
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner check.') & a_err='One level preconditioner check.')
goto 9999 goto 9999
endif endif
call p%precv(1)%sm%build(a,desc_a,upd_,info,& call prec%precv(1)%sm%build(a,desc_a,upd_,info,&
& amold=amold,vmold=vmold,imold=imold) & amold=amold,vmold=vmold,imold=imold)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner build.') & a_err='One level preconditioner build.')
goto 9999 goto 9999
endif endif
! !
! Number of levels > 1 ! Number of levels > 1
@ -190,16 +189,25 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold)
! !
! Build the multilevel preconditioner ! Build the multilevel preconditioner
! !
call mld_mlprec_bld(a,desc_a,p,info,& call prec%hierarchy_build(a,desc_a,info)
& amold=amold,vmold=vmold,imold=imold)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& info=psb_err_internal_error_
& a_err='Multilevel preconditioner build.') call psb_errpush(info,name,a_err='Error from hierarchy build')
goto 9999 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 end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

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

@ -84,12 +84,8 @@
! lowercase strings). ! lowercase strings).
! info - integer, output. ! info - integer, output.
! Error code. ! 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 psb_base_mod
use mld_c_prec_mod, mld_protect_name => mld_cprecinit use mld_c_prec_mod, mld_protect_name => mld_cprecinit
@ -106,10 +102,9 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
implicit none implicit none
! Arguments ! Arguments
type(mld_cprec_type), intent(inout) :: p class(mld_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nlev
! Local variables ! Local variables
integer(psb_ipk_) :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
@ -117,97 +112,92 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
if (allocated(p%precv)) then if (allocated(prec%precv)) then
call mld_precfree(p,info) call prec%free(info)
if (info /= psb_success_) then if (info /= psb_success_) then
! Do we want to do something? ! Do we want to do something?
endif endif
endif endif
p%coarse_aggr_size = -1 prec%coarse_aggr_size = -1
select case(psb_toupper(ptype(1:len_trim(ptype)))) select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NOPREC','NONE') case ('NOPREC','NONE')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
allocate(mld_c_base_smoother_type :: p%precv(ilev_)%sm, stat=info) allocate(mld_c_base_smoother_type :: prec%precv(ilev_)%sm, stat=info)
if (info /= psb_success_) return if (info /= psb_success_) return
allocate(mld_c_id_solver_type :: p%precv(ilev_)%sm%sv, stat=info) allocate(mld_c_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('JAC','DIAG','JACOBI') case ('JAC','DIAG','JACOBI')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 (info /= psb_success_) return
allocate(mld_c_diag_solver_type :: p%precv(ilev_)%sm%sv, stat=info) allocate(mld_c_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('BJAC') case ('BJAC')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('AS') case ('AS')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 if (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('ML') case ('ML')
if (present(nlev)) then nlev_ = prec%max_prec_levs
nlev_ = max(1,nlev)
p%max_prec_levs = nlev_
else
nlev_ = p%max_prec_levs
end if
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 if (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
if (nlev_ == 1) return if (nlev_ == 1) return
do ilev_ = 2, nlev_ -1 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 if (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
end do end do
ilev_ = nlev_ 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 (info /= psb_success_) return
#if defined(HAVE_SLU_) #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 #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 #endif
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
p%precv(ilev_)%parms%coarse_solve = mld_bjac_ prec%precv(ilev_)%parms%coarse_solve = mld_bjac_
call p%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info) call prec%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info) call prec%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call prec%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info) call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.05_psb_spk_ thr = 0.05_psb_spk_
scale = 1.0_psb_spk_ scale = 1.0_psb_spk_
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
call p%precv(ilev_)%set(mld_aggr_scale_,scale,info) call prec%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_filter_,mld_filter_mat_,info)
end do end do
case default case default

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

@ -72,6 +72,7 @@
subroutine mld_d_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) subroutine mld_d_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_d_inner_mod, mld_protect_name => mld_d_dec_map_bld use mld_d_inner_mod, mld_protect_name => mld_d_dec_map_bld
implicit none implicit none

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

@ -65,7 +65,7 @@
! info - integer, output. ! info - integer, output.
! Error code. ! 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 psb_base_mod
use mld_d_inner_mod use mld_d_inner_mod
@ -76,7 +76,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
! Arguments ! Arguments
type(psb_dspmat_type),intent(in), target :: a type(psb_dspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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 integer(psb_ipk_), intent(out) :: info
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
@ -106,7 +106,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
int_err(1) = 0 int_err(1) = 0
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
p%ictxt = ictxt prec%ictxt = ictxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
@ -127,7 +127,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
! !$ endif ! !$ endif
upd_ = 'F' upd_ = 'F'
if (.not.allocated(p%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_dprecinit !! Error: should have called mld_dprecinit
info=3111 info=3111
call psb_errpush(info,name) 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 ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
casize = p%coarse_aggr_size casize = prec%coarse_aggr_size
mxplevs = p%max_prec_levs mxplevs = prec%max_prec_levs
mnaggratio = p%min_aggr_ratio mnaggratio = prec%min_aggr_ratio
casize = p%coarse_aggr_size casize = prec%coarse_aggr_size
iszv = size(p%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ictxt,mnaggratio)
if (casize /= p%coarse_aggr_size) then if (casize /= prec%coarse_aggr_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
goto 9999 goto 9999
end if end if
if (mxplevs /= p%max_prec_levs) then if (mxplevs /= prec%max_prec_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') call psb_errpush(info,name,a_err='Inconsistent max_prec_levs')
goto 9999 goto 9999
end if end if
if (mnaggratio /= p%min_aggr_ratio) then if (mnaggratio /= prec%min_aggr_ratio) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio')
goto 9999 goto 9999
end if end if
if (iszv /= size(p%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999 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 ! This is OK, since it may be called by the user even if there
! is only one level ! is only one level
! !
p%precv(1)%base_a => a prec%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -213,13 +213,13 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
end if end if
nplevs = max(itwo,mxplevs) nplevs = max(itwo,mxplevs)
coarseparms = p%precv(iszv)%parms coarseparms = prec%precv(iszv)%parms
baseparms = p%precv(1)%parms baseparms = prec%precv(1)%parms
medparms = p%precv(2)%parms medparms = prec%precv(2)%parms
call save_smoothers(p%precv(iszv),coarse_sm,coarse_sm2,info) call save_smoothers(prec%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(prec%precv(2),med_sm,med_sm2,info)
if (info == 0) call save_smoothers(p%precv(1),base_sm,base_sm2,info) if (info == 0) call save_smoothers(prec%precv(1),base_sm,base_sm2,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) 'Error in saving smoothers',info write(0,*) 'Error in saving smoothers',info
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') 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) allocate(tprecv(nplevs),stat=info)
! First all existing levels ! First all existing levels
if (info == 0) tprecv(1)%parms = baseparms 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 do i=2, min(iszv,nplevs) - 1
if (info == 0) tprecv(i)%parms = medparms 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 end do
! Further intermediates, if any ! Further intermediates, if any
do i=iszv-1, nplevs - 1 do i=iszv-1, nplevs - 1
@ -252,24 +252,24 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
endif endif
do i=1,iszv do i=1,iszv
call p%precv(i)%free(info) call prec%precv(i)%free(info)
end do end do
call move_alloc(tprecv,p%precv) call move_alloc(tprecv,prec%precv)
iszv = size(p%precv) iszv = size(prec%precv)
end if end if
! !
! Finest level first; remember to fix base_a and base_desc ! Finest level first; remember to fix base_a and base_desc
! !
p%precv(1)%base_a => a prec%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
newsz = 0 newsz = 0
array_build_loop: do i=2, iszv array_build_loop: do i=2, iszv
! !
! Check on the iprcparm contents: they should be the same ! Check on the iprcparm contents: they should be the same
! on all processes. ! on all processes.
! !
call psb_bcast(ictxt,p%precv(i)%parms) call psb_bcast(ictxt,prec%precv(i)%parms)
! !
! Sanity checks on the parameters ! 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 ! 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) & mld_distr_mat_,is_distr_ml_coarse_mat)
end if 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 ! Build the mapping between levels i-1 and i and the matrix
! at level i ! at level i
! !
if (info == psb_success_) call mld_aggrmap_bld(p%precv(i),& if (info == psb_success_) call mld_aggrmap_bld(prec%precv(i),&
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then 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 ! 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. ! 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 if (i==2) then
sizeratio = desc_a%get_global_rows()/sizeratio sizeratio = desc_a%get_global_rows()/sizeratio
else else
sizeratio = sum(p%precv(i-1)%map%naggr)/sizeratio sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
end if end if
p%precv(i)%szratio = sizeratio prec%precv(i)%szratio = sizeratio
if (iaggsize <= casize) then if (iaggsize <= casize) then
newsz = i newsz = i
end if end if
@ -334,7 +334,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
end if end if
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 newsz=i-1
if (me == 0) then if (me == 0) then
write(debug_unit,*) trim(name),& 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 ! This is awkward, we are saving the aggregation parms, for the sake
! of distr/repl matrix at coarse level. Should be rethought. ! of distr/repl matrix at coarse level. Should be rethought.
! !
athresh = p%precv(newsz)%parms%aggr_thresh athresh = prec%precv(newsz)%parms%aggr_thresh
ascale = p%precv(newsz)%parms%aggr_scale ascale = prec%precv(newsz)%parms%aggr_scale
aomega = p%precv(newsz)%parms%aggr_omega_val aomega = prec%precv(newsz)%parms%aggr_omega_val
if (info == 0) p%precv(newsz)%parms = coarseparms if (info == 0) prec%precv(newsz)%parms = coarseparms
p%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_thresh = athresh
p%precv(newsz)%parms%aggr_scale = ascale prec%precv(newsz)%parms%aggr_scale = ascale
p%precv(newsz)%parms%aggr_omega_val = aomega 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 if (newsz < i) then
! !
! We are going back and revisit a previous leve; ! We are going back and revisit a previous leve;
! recover the aggregation. ! recover the aggregation.
! !
ilaggr = p%precv(newsz)%map%iaggr ilaggr = prec%precv(newsz)%map%iaggr
nlaggr = p%precv(newsz)%map%naggr nlaggr = prec%precv(newsz)%map%naggr
call p%precv(newsz)%tprol%clone(op_prol,info) call prec%precv(newsz)%tprol%clone(op_prol,info)
end if end if
if (info == psb_success_) call mld_lev_mat_asb(p%precv(newsz),& if (info == psb_success_) call mld_lev_mat_asb(prec%precv(newsz),&
& p%precv(newsz-1)%base_a,p%precv(newsz-1)%base_desc,& & prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,&
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
@ -385,8 +385,8 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
endif endif
exit array_build_loop exit array_build_loop
else else
if (info == psb_success_) call mld_lev_mat_asb(p%precv(i),& if (info == psb_success_) call mld_lev_mat_asb(prec%precv(i),&
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
@ -409,12 +409,12 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
goto 9999 goto 9999
endif endif
do i=1,newsz do i=1,newsz
call p%precv(i)%move_alloc(tprecv(i),info) call prec%precv(i)%move_alloc(tprecv(i),info)
end do end do
do i=newsz+1, iszv do i=newsz+1, iszv
call p%precv(i)%free(info) call prec%precv(i)%free(info)
end do end do
call move_alloc(tprecv,p%precv) call move_alloc(tprecv,prec%precv)
! Ignore errors from transfer ! Ignore errors from transfer
info = psb_success_ 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 ! Fix the pointers, but the level 1 should
! be already OK ! be already OK
do i=2, iszv do i=2, iszv
p%precv(i)%base_a => p%precv(i)%ac prec%precv(i)%base_a => prec%precv(i)%ac
p%precv(i)%base_desc => p%precv(i)%desc_ac prec%precv(i)%base_desc => prec%precv(i)%desc_ac
p%precv(i)%map%p_desc_X => p%precv(i-1)%base_desc prec%precv(i)%map%p_desc_X => prec%precv(i-1)%base_desc
p%precv(i)%map%p_desc_Y => p%precv(i)%base_desc prec%precv(i)%map%p_desc_Y => prec%precv(i)%base_desc
end do end do
end if end if
@ -436,9 +436,9 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info)
goto 9999 goto 9999
endif endif
iszv = size(p%precv) iszv = size(prec%precv)
call p%cmp_complexity() call prec%cmp_complexity()
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&

2
mlprec/impl/mld_d_lev_aggrmap_bld.f90
Unescape Escape View File

@ -1,3 +1,4 @@
! !
! !
! MLD2P4 version 2.1 ! MLD2P4 version 2.1
@ -77,6 +78,7 @@
subroutine mld_d_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info) subroutine mld_d_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_d_inner_mod, mld_protect_name => mld_d_lev_aggrmap_bld use mld_d_inner_mod, mld_protect_name => mld_d_lev_aggrmap_bld
implicit none implicit none

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

@ -88,6 +88,7 @@
subroutine mld_d_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) subroutine mld_d_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_d_inner_mod, mld_protect_name => mld_d_lev_aggrmat_asb use mld_d_inner_mod, mld_protect_name => mld_d_lev_aggrmat_asb
implicit none implicit none

14
mlprec/impl/mld_d_smoothers_bld.f90
Unescape Escape View File

@ -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 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 use mld_d_prec_mod, mld_protect_name => mld_d_smoothers_bld
Implicit None Implicit None
@ -90,7 +90,7 @@ subroutine mld_d_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
! Arguments ! Arguments
type(psb_dspmat_type),intent(in), target :: a type(psb_dspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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 integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold 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 ! !$ endif
upd_ = 'F' upd_ = 'F'
if (.not.allocated(p%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_dprecinit !! Error: should have called mld_dprecinit
info=3111 info=3111
call psb_errpush(info,name) 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 ! Check to ensure all procs have the same
! !
iszv = size(p%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999 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 ! 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 if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Error @ level',i write(ch_err,'(a,i7)') 'Error @ level',i

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

@ -88,6 +88,7 @@
subroutine mld_daggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info) subroutine mld_daggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_d_inner_mod, mld_protect_name => mld_daggrmap_bld use mld_d_inner_mod, mld_protect_name => mld_daggrmap_bld
implicit none implicit none

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

@ -120,6 +120,7 @@
subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_d_inner_mod, mld_protect_name => mld_daggrmat_asb use mld_d_inner_mod, mld_protect_name => mld_daggrmat_asb
implicit none implicit none

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

@ -84,6 +84,7 @@
! !
subroutine mld_daggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_daggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_d_inner_mod, mld_protect_name => mld_daggrmat_biz_asb use mld_d_inner_mod, mld_protect_name => mld_daggrmat_biz_asb
implicit none implicit none

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

@ -112,6 +112,7 @@
! !
subroutine mld_daggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_daggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_d_inner_mod, mld_protect_name => mld_daggrmat_minnrg_asb use mld_d_inner_mod, mld_protect_name => mld_daggrmat_minnrg_asb
implicit none implicit none

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

@ -100,6 +100,7 @@
! !
subroutine mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_d_inner_mod, mld_protect_name => mld_daggrmat_nosmth_asb use mld_d_inner_mod, mld_protect_name => mld_daggrmat_nosmth_asb
implicit none implicit none

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

@ -113,6 +113,7 @@
! !
subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_d_inner_mod, mld_protect_name => mld_daggrmat_smth_asb use mld_d_inner_mod, mld_protect_name => mld_daggrmat_smth_asb
implicit none implicit none

2
mlprec/impl/mld_dmlprec_aply.f90
Unescape Escape View File

@ -299,6 +299,7 @@
subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_d_inner_mod, mld_protect_name => mld_dmlprec_aply_vect use mld_d_inner_mod, mld_protect_name => mld_dmlprec_aply_vect
implicit none 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) subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_d_inner_mod, mld_protect_name => mld_dmlprec_aply use mld_d_inner_mod, mld_protect_name => mld_dmlprec_aply
implicit none implicit none

4
mlprec/impl/mld_dmlprec_bld.f90
Unescape Escape View File

@ -123,7 +123,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
call mld_d_hierarchy_bld(a,desc_a,p,info) call p%hierarchy_build(a,desc_a,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_internal_error_ 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() 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 if (info /= psb_success_) then
info=psb_err_internal_error_ info=psb_err_internal_error_

10
mlprec/impl/mld_dprecaply.f90
Unescape Escape View File

@ -75,7 +75,7 @@
subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work) subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod 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 implicit none
@ -206,7 +206,7 @@ end subroutine mld_dprecaply
subroutine mld_dprecaply1(prec,x,desc_data,info,trans) subroutine mld_dprecaply1(prec,x,desc_data,info,trans)
use psb_base_mod 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 implicit none
@ -240,7 +240,7 @@ subroutine mld_dprecaply1(prec,x,desc_data,info,trans)
goto 9999 goto 9999
end if 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 if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precaply') call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precaply')
goto 9999 goto 9999
@ -267,7 +267,7 @@ end subroutine mld_dprecaply1
subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work) subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
use psb_base_mod 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 implicit none
@ -368,7 +368,7 @@ end subroutine mld_dprecaply2_vect
subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
use psb_base_mod 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 implicit none

72
mlprec/impl/mld_dprecbld.f90
Unescape Escape View File

@ -59,18 +59,17 @@
! info - integer, output. ! info - integer, output.
! Error code. ! 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 psb_base_mod
use mld_d_inner_mod, mld_protect_name1 => mld_dprecbld use mld_d_prec_mod, mld_protect_name => mld_dprecbld
use mld_d_prec_mod, mld_protect_name2 => mld_dprecbld
Implicit None Implicit None
! Arguments ! Arguments
type(psb_dspmat_type),intent(in), target :: a type(psb_dspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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 integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold 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 int_err(1) = 0
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
p%ictxt = ictxt prec%ictxt = ictxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -122,7 +121,7 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold)
!!$ endif !!$ endif
upd_ = 'F' upd_ = 'F'
if (.not.allocated(p%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_dprecinit !! Error: should have called mld_dprecinit
info=3111 info=3111
call psb_errpush(info,name) 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 ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
iszv = size(p%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999 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 ! Check on the iprcparm contents: they should be the same
! on all processes. ! 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 prec%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
goto 9999 goto 9999
end if end if
call p%precv(1)%check(info) call prec%precv(1)%check(info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) ' Smoother check error',info write(0,*) ' Smoother check error',info
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner check.') & a_err='One level preconditioner check.')
goto 9999 goto 9999
endif endif
call p%precv(1)%sm%build(a,desc_a,upd_,info,& call prec%precv(1)%sm%build(a,desc_a,upd_,info,&
& amold=amold,vmold=vmold,imold=imold) & amold=amold,vmold=vmold,imold=imold)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner build.') & a_err='One level preconditioner build.')
goto 9999 goto 9999
endif endif
! !
! Number of levels > 1 ! Number of levels > 1
@ -190,16 +189,25 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold)
! !
! Build the multilevel preconditioner ! Build the multilevel preconditioner
! !
call mld_mlprec_bld(a,desc_a,p,info,& call prec%hierarchy_build(a,desc_a,info)
& amold=amold,vmold=vmold,imold=imold)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& info=psb_err_internal_error_
& a_err='Multilevel preconditioner build.') call psb_errpush(info,name,a_err='Error from hierarchy build')
goto 9999 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 end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

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

@ -84,12 +84,8 @@
! lowercase strings). ! lowercase strings).
! info - integer, output. ! info - integer, output.
! Error code. ! 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 psb_base_mod
use mld_d_prec_mod, mld_protect_name => mld_dprecinit use mld_d_prec_mod, mld_protect_name => mld_dprecinit
@ -109,10 +105,9 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
implicit none implicit none
! Arguments ! Arguments
type(mld_dprec_type), intent(inout) :: p class(mld_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nlev
! Local variables ! Local variables
integer(psb_ipk_) :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
@ -120,99 +115,94 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
if (allocated(p%precv)) then if (allocated(prec%precv)) then
call mld_precfree(p,info) call prec%free(info)
if (info /= psb_success_) then if (info /= psb_success_) then
! Do we want to do something? ! Do we want to do something?
endif endif
endif endif
p%coarse_aggr_size = -1 prec%coarse_aggr_size = -1
select case(psb_toupper(ptype(1:len_trim(ptype)))) select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NOPREC','NONE') case ('NOPREC','NONE')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
allocate(mld_d_base_smoother_type :: p%precv(ilev_)%sm, stat=info) allocate(mld_d_base_smoother_type :: prec%precv(ilev_)%sm, stat=info)
if (info /= psb_success_) return if (info /= psb_success_) return
allocate(mld_d_id_solver_type :: p%precv(ilev_)%sm%sv, stat=info) allocate(mld_d_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('JAC','DIAG','JACOBI') case ('JAC','DIAG','JACOBI')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 (info /= psb_success_) return
allocate(mld_d_diag_solver_type :: p%precv(ilev_)%sm%sv, stat=info) allocate(mld_d_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('BJAC') case ('BJAC')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('AS') case ('AS')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 if (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('ML') case ('ML')
if (present(nlev)) then nlev_ = prec%max_prec_levs
nlev_ = max(1,nlev)
p%max_prec_levs = nlev_
else
nlev_ = p%max_prec_levs
end if
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 if (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
if (nlev_ == 1) return if (nlev_ == 1) return
do ilev_ = 2, nlev_ -1 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 if (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
end do end do
ilev_ = nlev_ 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 (info /= psb_success_) return
#if defined(HAVE_UMF_) #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_) #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 #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 #endif
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
p%precv(ilev_)%parms%coarse_solve = mld_bjac_ prec%precv(ilev_)%parms%coarse_solve = mld_bjac_
call p%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info) call prec%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info) call prec%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call prec%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info) call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.05_psb_dpk_ thr = 0.05_psb_dpk_
scale = 1.0_psb_dpk_ scale = 1.0_psb_dpk_
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
call p%precv(ilev_)%set(mld_aggr_scale_,scale,info) call prec%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_filter_,mld_filter_mat_,info)
end do end do
case default case default

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

@ -72,6 +72,7 @@
subroutine mld_s_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) subroutine mld_s_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_s_inner_mod, mld_protect_name => mld_s_dec_map_bld use mld_s_inner_mod, mld_protect_name => mld_s_dec_map_bld
implicit none implicit none

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

@ -65,7 +65,7 @@
! info - integer, output. ! info - integer, output.
! Error code. ! 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 psb_base_mod
use mld_s_inner_mod use mld_s_inner_mod
@ -76,7 +76,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
! Arguments ! Arguments
type(psb_sspmat_type),intent(in), target :: a type(psb_sspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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 integer(psb_ipk_), intent(out) :: info
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
@ -106,7 +106,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
int_err(1) = 0 int_err(1) = 0
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
p%ictxt = ictxt prec%ictxt = ictxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
@ -127,7 +127,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
! !$ endif ! !$ endif
upd_ = 'F' upd_ = 'F'
if (.not.allocated(p%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_sprecinit !! Error: should have called mld_sprecinit
info=3111 info=3111
call psb_errpush(info,name) 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 ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
casize = p%coarse_aggr_size casize = prec%coarse_aggr_size
mxplevs = p%max_prec_levs mxplevs = prec%max_prec_levs
mnaggratio = p%min_aggr_ratio mnaggratio = prec%min_aggr_ratio
casize = p%coarse_aggr_size casize = prec%coarse_aggr_size
iszv = size(p%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ictxt,mnaggratio)
if (casize /= p%coarse_aggr_size) then if (casize /= prec%coarse_aggr_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
goto 9999 goto 9999
end if end if
if (mxplevs /= p%max_prec_levs) then if (mxplevs /= prec%max_prec_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') call psb_errpush(info,name,a_err='Inconsistent max_prec_levs')
goto 9999 goto 9999
end if end if
if (mnaggratio /= p%min_aggr_ratio) then if (mnaggratio /= prec%min_aggr_ratio) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio')
goto 9999 goto 9999
end if end if
if (iszv /= size(p%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999 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 ! This is OK, since it may be called by the user even if there
! is only one level ! is only one level
! !
p%precv(1)%base_a => a prec%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -213,13 +213,13 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
end if end if
nplevs = max(itwo,mxplevs) nplevs = max(itwo,mxplevs)
coarseparms = p%precv(iszv)%parms coarseparms = prec%precv(iszv)%parms
baseparms = p%precv(1)%parms baseparms = prec%precv(1)%parms
medparms = p%precv(2)%parms medparms = prec%precv(2)%parms
call save_smoothers(p%precv(iszv),coarse_sm,coarse_sm2,info) call save_smoothers(prec%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(prec%precv(2),med_sm,med_sm2,info)
if (info == 0) call save_smoothers(p%precv(1),base_sm,base_sm2,info) if (info == 0) call save_smoothers(prec%precv(1),base_sm,base_sm2,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) 'Error in saving smoothers',info write(0,*) 'Error in saving smoothers',info
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') 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) allocate(tprecv(nplevs),stat=info)
! First all existing levels ! First all existing levels
if (info == 0) tprecv(1)%parms = baseparms 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 do i=2, min(iszv,nplevs) - 1
if (info == 0) tprecv(i)%parms = medparms 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 end do
! Further intermediates, if any ! Further intermediates, if any
do i=iszv-1, nplevs - 1 do i=iszv-1, nplevs - 1
@ -252,24 +252,24 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
endif endif
do i=1,iszv do i=1,iszv
call p%precv(i)%free(info) call prec%precv(i)%free(info)
end do end do
call move_alloc(tprecv,p%precv) call move_alloc(tprecv,prec%precv)
iszv = size(p%precv) iszv = size(prec%precv)
end if end if
! !
! Finest level first; remember to fix base_a and base_desc ! Finest level first; remember to fix base_a and base_desc
! !
p%precv(1)%base_a => a prec%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
newsz = 0 newsz = 0
array_build_loop: do i=2, iszv array_build_loop: do i=2, iszv
! !
! Check on the iprcparm contents: they should be the same ! Check on the iprcparm contents: they should be the same
! on all processes. ! on all processes.
! !
call psb_bcast(ictxt,p%precv(i)%parms) call psb_bcast(ictxt,prec%precv(i)%parms)
! !
! Sanity checks on the parameters ! 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 ! 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) & mld_distr_mat_,is_distr_ml_coarse_mat)
end if 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 ! Build the mapping between levels i-1 and i and the matrix
! at level i ! at level i
! !
if (info == psb_success_) call mld_aggrmap_bld(p%precv(i),& if (info == psb_success_) call mld_aggrmap_bld(prec%precv(i),&
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then 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 ! 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. ! 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 if (i==2) then
sizeratio = desc_a%get_global_rows()/sizeratio sizeratio = desc_a%get_global_rows()/sizeratio
else else
sizeratio = sum(p%precv(i-1)%map%naggr)/sizeratio sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
end if end if
p%precv(i)%szratio = sizeratio prec%precv(i)%szratio = sizeratio
if (iaggsize <= casize) then if (iaggsize <= casize) then
newsz = i newsz = i
end if end if
@ -334,7 +334,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
end if end if
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 newsz=i-1
if (me == 0) then if (me == 0) then
write(debug_unit,*) trim(name),& 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 ! This is awkward, we are saving the aggregation parms, for the sake
! of distr/repl matrix at coarse level. Should be rethought. ! of distr/repl matrix at coarse level. Should be rethought.
! !
athresh = p%precv(newsz)%parms%aggr_thresh athresh = prec%precv(newsz)%parms%aggr_thresh
ascale = p%precv(newsz)%parms%aggr_scale ascale = prec%precv(newsz)%parms%aggr_scale
aomega = p%precv(newsz)%parms%aggr_omega_val aomega = prec%precv(newsz)%parms%aggr_omega_val
if (info == 0) p%precv(newsz)%parms = coarseparms if (info == 0) prec%precv(newsz)%parms = coarseparms
p%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_thresh = athresh
p%precv(newsz)%parms%aggr_scale = ascale prec%precv(newsz)%parms%aggr_scale = ascale
p%precv(newsz)%parms%aggr_omega_val = aomega 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 if (newsz < i) then
! !
! We are going back and revisit a previous leve; ! We are going back and revisit a previous leve;
! recover the aggregation. ! recover the aggregation.
! !
ilaggr = p%precv(newsz)%map%iaggr ilaggr = prec%precv(newsz)%map%iaggr
nlaggr = p%precv(newsz)%map%naggr nlaggr = prec%precv(newsz)%map%naggr
call p%precv(newsz)%tprol%clone(op_prol,info) call prec%precv(newsz)%tprol%clone(op_prol,info)
end if end if
if (info == psb_success_) call mld_lev_mat_asb(p%precv(newsz),& if (info == psb_success_) call mld_lev_mat_asb(prec%precv(newsz),&
& p%precv(newsz-1)%base_a,p%precv(newsz-1)%base_desc,& & prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,&
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
@ -385,8 +385,8 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
endif endif
exit array_build_loop exit array_build_loop
else else
if (info == psb_success_) call mld_lev_mat_asb(p%precv(i),& if (info == psb_success_) call mld_lev_mat_asb(prec%precv(i),&
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
@ -409,12 +409,12 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
goto 9999 goto 9999
endif endif
do i=1,newsz do i=1,newsz
call p%precv(i)%move_alloc(tprecv(i),info) call prec%precv(i)%move_alloc(tprecv(i),info)
end do end do
do i=newsz+1, iszv do i=newsz+1, iszv
call p%precv(i)%free(info) call prec%precv(i)%free(info)
end do end do
call move_alloc(tprecv,p%precv) call move_alloc(tprecv,prec%precv)
! Ignore errors from transfer ! Ignore errors from transfer
info = psb_success_ 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 ! Fix the pointers, but the level 1 should
! be already OK ! be already OK
do i=2, iszv do i=2, iszv
p%precv(i)%base_a => p%precv(i)%ac prec%precv(i)%base_a => prec%precv(i)%ac
p%precv(i)%base_desc => p%precv(i)%desc_ac prec%precv(i)%base_desc => prec%precv(i)%desc_ac
p%precv(i)%map%p_desc_X => p%precv(i-1)%base_desc prec%precv(i)%map%p_desc_X => prec%precv(i-1)%base_desc
p%precv(i)%map%p_desc_Y => p%precv(i)%base_desc prec%precv(i)%map%p_desc_Y => prec%precv(i)%base_desc
end do end do
end if end if
@ -436,9 +436,9 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info)
goto 9999 goto 9999
endif endif
iszv = size(p%precv) iszv = size(prec%precv)
call p%cmp_complexity() call prec%cmp_complexity()
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&

2
mlprec/impl/mld_s_lev_aggrmap_bld.f90
Unescape Escape View File

@ -1,3 +1,4 @@
! !
! !
! MLD2P4 version 2.1 ! MLD2P4 version 2.1
@ -77,6 +78,7 @@
subroutine mld_s_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info) subroutine mld_s_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_s_inner_mod, mld_protect_name => mld_s_lev_aggrmap_bld use mld_s_inner_mod, mld_protect_name => mld_s_lev_aggrmap_bld
implicit none implicit none

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

@ -88,6 +88,7 @@
subroutine mld_s_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) subroutine mld_s_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_s_inner_mod, mld_protect_name => mld_s_lev_aggrmat_asb use mld_s_inner_mod, mld_protect_name => mld_s_lev_aggrmat_asb
implicit none implicit none

14
mlprec/impl/mld_s_smoothers_bld.f90
Unescape Escape View File

@ -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 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 use mld_s_prec_mod, mld_protect_name => mld_s_smoothers_bld
Implicit None Implicit None
@ -90,7 +90,7 @@ subroutine mld_s_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
! Arguments ! Arguments
type(psb_sspmat_type),intent(in), target :: a type(psb_sspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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 integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold 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 ! !$ endif
upd_ = 'F' upd_ = 'F'
if (.not.allocated(p%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_sprecinit !! Error: should have called mld_sprecinit
info=3111 info=3111
call psb_errpush(info,name) 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 ! Check to ensure all procs have the same
! !
iszv = size(p%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999 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 ! 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 if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Error @ level',i write(ch_err,'(a,i7)') 'Error @ level',i

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

@ -88,6 +88,7 @@
subroutine mld_saggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info) subroutine mld_saggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_s_inner_mod, mld_protect_name => mld_saggrmap_bld use mld_s_inner_mod, mld_protect_name => mld_saggrmap_bld
implicit none implicit none

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

@ -120,6 +120,7 @@
subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_s_inner_mod, mld_protect_name => mld_saggrmat_asb use mld_s_inner_mod, mld_protect_name => mld_saggrmat_asb
implicit none implicit none

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

@ -84,6 +84,7 @@
! !
subroutine mld_saggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_saggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_s_inner_mod, mld_protect_name => mld_saggrmat_biz_asb use mld_s_inner_mod, mld_protect_name => mld_saggrmat_biz_asb
implicit none implicit none

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

@ -112,6 +112,7 @@
! !
subroutine mld_saggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_saggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_s_inner_mod, mld_protect_name => mld_saggrmat_minnrg_asb use mld_s_inner_mod, mld_protect_name => mld_saggrmat_minnrg_asb
implicit none implicit none

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

@ -100,6 +100,7 @@
! !
subroutine mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_s_inner_mod, mld_protect_name => mld_saggrmat_nosmth_asb use mld_s_inner_mod, mld_protect_name => mld_saggrmat_nosmth_asb
implicit none implicit none

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

@ -113,6 +113,7 @@
! !
subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_s_inner_mod, mld_protect_name => mld_saggrmat_smth_asb use mld_s_inner_mod, mld_protect_name => mld_saggrmat_smth_asb
implicit none implicit none

2
mlprec/impl/mld_smlprec_aply.f90
Unescape Escape View File

@ -299,6 +299,7 @@
subroutine mld_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) subroutine mld_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_s_inner_mod, mld_protect_name => mld_smlprec_aply_vect use mld_s_inner_mod, mld_protect_name => mld_smlprec_aply_vect
implicit none 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) subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_s_inner_mod, mld_protect_name => mld_smlprec_aply use mld_s_inner_mod, mld_protect_name => mld_smlprec_aply
implicit none implicit none

4
mlprec/impl/mld_smlprec_bld.f90
Unescape Escape View File

@ -123,7 +123,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
call mld_s_hierarchy_bld(a,desc_a,p,info) call p%hierarchy_build(a,desc_a,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_internal_error_ 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() 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 if (info /= psb_success_) then
info=psb_err_internal_error_ info=psb_err_internal_error_

10
mlprec/impl/mld_sprecaply.f90
Unescape Escape View File

@ -75,7 +75,7 @@
subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work) subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod 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 implicit none
@ -206,7 +206,7 @@ end subroutine mld_sprecaply
subroutine mld_sprecaply1(prec,x,desc_data,info,trans) subroutine mld_sprecaply1(prec,x,desc_data,info,trans)
use psb_base_mod 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 implicit none
@ -240,7 +240,7 @@ subroutine mld_sprecaply1(prec,x,desc_data,info,trans)
goto 9999 goto 9999
end if 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 if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precaply') call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precaply')
goto 9999 goto 9999
@ -267,7 +267,7 @@ end subroutine mld_sprecaply1
subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work) subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
use psb_base_mod 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 implicit none
@ -368,7 +368,7 @@ end subroutine mld_sprecaply2_vect
subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
use psb_base_mod 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 implicit none

70
mlprec/impl/mld_sprecbld.f90
Unescape Escape View File

@ -59,10 +59,9 @@
! info - integer, output. ! info - integer, output.
! Error code. ! 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 psb_base_mod
use mld_s_inner_mod
use mld_s_prec_mod, mld_protect_name => mld_sprecbld use mld_s_prec_mod, mld_protect_name => mld_sprecbld
Implicit None Implicit None
@ -70,7 +69,7 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold)
! Arguments ! Arguments
type(psb_sspmat_type),intent(in), target :: a type(psb_sspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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 integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold 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 int_err(1) = 0
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
p%ictxt = ictxt prec%ictxt = ictxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -122,7 +121,7 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold)
!!$ endif !!$ endif
upd_ = 'F' upd_ = 'F'
if (.not.allocated(p%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_sprecinit !! Error: should have called mld_sprecinit
info=3111 info=3111
call psb_errpush(info,name) 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 ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
iszv = size(p%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999 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 ! Check on the iprcparm contents: they should be the same
! on all processes. ! 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 prec%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
goto 9999 goto 9999
end if end if
call p%precv(1)%check(info) call prec%precv(1)%check(info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) ' Smoother check error',info write(0,*) ' Smoother check error',info
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner check.') & a_err='One level preconditioner check.')
goto 9999 goto 9999
endif endif
call p%precv(1)%sm%build(a,desc_a,upd_,info,& call prec%precv(1)%sm%build(a,desc_a,upd_,info,&
& amold=amold,vmold=vmold,imold=imold) & amold=amold,vmold=vmold,imold=imold)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner build.') & a_err='One level preconditioner build.')
goto 9999 goto 9999
endif endif
! !
! Number of levels > 1 ! Number of levels > 1
@ -190,16 +189,25 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold)
! !
! Build the multilevel preconditioner ! Build the multilevel preconditioner
! !
call mld_mlprec_bld(a,desc_a,p,info,& call prec%hierarchy_build(a,desc_a,info)
& amold=amold,vmold=vmold,imold=imold)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& info=psb_err_internal_error_
& a_err='Multilevel preconditioner build.') call psb_errpush(info,name,a_err='Error from hierarchy build')
goto 9999 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 end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

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

@ -84,12 +84,8 @@
! lowercase strings). ! lowercase strings).
! info - integer, output. ! info - integer, output.
! Error code. ! 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 psb_base_mod
use mld_s_prec_mod, mld_protect_name => mld_sprecinit use mld_s_prec_mod, mld_protect_name => mld_sprecinit
@ -106,10 +102,9 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
implicit none implicit none
! Arguments ! Arguments
type(mld_sprec_type), intent(inout) :: p class(mld_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nlev
! Local variables ! Local variables
integer(psb_ipk_) :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
@ -117,97 +112,92 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
if (allocated(p%precv)) then if (allocated(prec%precv)) then
call mld_precfree(p,info) call prec%free(info)
if (info /= psb_success_) then if (info /= psb_success_) then
! Do we want to do something? ! Do we want to do something?
endif endif
endif endif
p%coarse_aggr_size = -1 prec%coarse_aggr_size = -1
select case(psb_toupper(ptype(1:len_trim(ptype)))) select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NOPREC','NONE') case ('NOPREC','NONE')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
allocate(mld_s_base_smoother_type :: p%precv(ilev_)%sm, stat=info) allocate(mld_s_base_smoother_type :: prec%precv(ilev_)%sm, stat=info)
if (info /= psb_success_) return if (info /= psb_success_) return
allocate(mld_s_id_solver_type :: p%precv(ilev_)%sm%sv, stat=info) allocate(mld_s_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('JAC','DIAG','JACOBI') case ('JAC','DIAG','JACOBI')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 (info /= psb_success_) return
allocate(mld_s_diag_solver_type :: p%precv(ilev_)%sm%sv, stat=info) allocate(mld_s_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('BJAC') case ('BJAC')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('AS') case ('AS')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 if (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('ML') case ('ML')
if (present(nlev)) then nlev_ = prec%max_prec_levs
nlev_ = max(1,nlev)
p%max_prec_levs = nlev_
else
nlev_ = p%max_prec_levs
end if
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 if (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
if (nlev_ == 1) return if (nlev_ == 1) return
do ilev_ = 2, nlev_ -1 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 if (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
end do end do
ilev_ = nlev_ 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 (info /= psb_success_) return
#if defined(HAVE_SLU_) #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 #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 #endif
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
p%precv(ilev_)%parms%coarse_solve = mld_bjac_ prec%precv(ilev_)%parms%coarse_solve = mld_bjac_
call p%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info) call prec%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info) call prec%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call prec%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info) call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.05_psb_spk_ thr = 0.05_psb_spk_
scale = 1.0_psb_spk_ scale = 1.0_psb_spk_
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
call p%precv(ilev_)%set(mld_aggr_scale_,scale,info) call prec%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_filter_,mld_filter_mat_,info)
end do end do
case default case default

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

@ -72,6 +72,7 @@
subroutine mld_z_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) subroutine mld_z_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_z_inner_mod, mld_protect_name => mld_z_dec_map_bld use mld_z_inner_mod, mld_protect_name => mld_z_dec_map_bld
implicit none implicit none

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

@ -65,7 +65,7 @@
! info - integer, output. ! info - integer, output.
! Error code. ! 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 psb_base_mod
use mld_z_inner_mod use mld_z_inner_mod
@ -76,7 +76,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
! Arguments ! Arguments
type(psb_zspmat_type),intent(in), target :: a type(psb_zspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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 integer(psb_ipk_), intent(out) :: info
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
@ -106,7 +106,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
int_err(1) = 0 int_err(1) = 0
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
p%ictxt = ictxt prec%ictxt = ictxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
@ -127,7 +127,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
! !$ endif ! !$ endif
upd_ = 'F' upd_ = 'F'
if (.not.allocated(p%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_zprecinit !! Error: should have called mld_zprecinit
info=3111 info=3111
call psb_errpush(info,name) 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 ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
casize = p%coarse_aggr_size casize = prec%coarse_aggr_size
mxplevs = p%max_prec_levs mxplevs = prec%max_prec_levs
mnaggratio = p%min_aggr_ratio mnaggratio = prec%min_aggr_ratio
casize = p%coarse_aggr_size casize = prec%coarse_aggr_size
iszv = size(p%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ictxt,mnaggratio)
if (casize /= p%coarse_aggr_size) then if (casize /= prec%coarse_aggr_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
goto 9999 goto 9999
end if end if
if (mxplevs /= p%max_prec_levs) then if (mxplevs /= prec%max_prec_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') call psb_errpush(info,name,a_err='Inconsistent max_prec_levs')
goto 9999 goto 9999
end if end if
if (mnaggratio /= p%min_aggr_ratio) then if (mnaggratio /= prec%min_aggr_ratio) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio')
goto 9999 goto 9999
end if end if
if (iszv /= size(p%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999 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 ! This is OK, since it may be called by the user even if there
! is only one level ! is only one level
! !
p%precv(1)%base_a => a prec%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -213,13 +213,13 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
end if end if
nplevs = max(itwo,mxplevs) nplevs = max(itwo,mxplevs)
coarseparms = p%precv(iszv)%parms coarseparms = prec%precv(iszv)%parms
baseparms = p%precv(1)%parms baseparms = prec%precv(1)%parms
medparms = p%precv(2)%parms medparms = prec%precv(2)%parms
call save_smoothers(p%precv(iszv),coarse_sm,coarse_sm2,info) call save_smoothers(prec%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(prec%precv(2),med_sm,med_sm2,info)
if (info == 0) call save_smoothers(p%precv(1),base_sm,base_sm2,info) if (info == 0) call save_smoothers(prec%precv(1),base_sm,base_sm2,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) 'Error in saving smoothers',info write(0,*) 'Error in saving smoothers',info
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') 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) allocate(tprecv(nplevs),stat=info)
! First all existing levels ! First all existing levels
if (info == 0) tprecv(1)%parms = baseparms 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 do i=2, min(iszv,nplevs) - 1
if (info == 0) tprecv(i)%parms = medparms 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 end do
! Further intermediates, if any ! Further intermediates, if any
do i=iszv-1, nplevs - 1 do i=iszv-1, nplevs - 1
@ -252,24 +252,24 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
endif endif
do i=1,iszv do i=1,iszv
call p%precv(i)%free(info) call prec%precv(i)%free(info)
end do end do
call move_alloc(tprecv,p%precv) call move_alloc(tprecv,prec%precv)
iszv = size(p%precv) iszv = size(prec%precv)
end if end if
! !
! Finest level first; remember to fix base_a and base_desc ! Finest level first; remember to fix base_a and base_desc
! !
p%precv(1)%base_a => a prec%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
newsz = 0 newsz = 0
array_build_loop: do i=2, iszv array_build_loop: do i=2, iszv
! !
! Check on the iprcparm contents: they should be the same ! Check on the iprcparm contents: they should be the same
! on all processes. ! on all processes.
! !
call psb_bcast(ictxt,p%precv(i)%parms) call psb_bcast(ictxt,prec%precv(i)%parms)
! !
! Sanity checks on the parameters ! 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 ! 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) & mld_distr_mat_,is_distr_ml_coarse_mat)
end if 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 ! Build the mapping between levels i-1 and i and the matrix
! at level i ! at level i
! !
if (info == psb_success_) call mld_aggrmap_bld(p%precv(i),& if (info == psb_success_) call mld_aggrmap_bld(prec%precv(i),&
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then 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 ! 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. ! 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 if (i==2) then
sizeratio = desc_a%get_global_rows()/sizeratio sizeratio = desc_a%get_global_rows()/sizeratio
else else
sizeratio = sum(p%precv(i-1)%map%naggr)/sizeratio sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
end if end if
p%precv(i)%szratio = sizeratio prec%precv(i)%szratio = sizeratio
if (iaggsize <= casize) then if (iaggsize <= casize) then
newsz = i newsz = i
end if end if
@ -334,7 +334,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
end if end if
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 newsz=i-1
if (me == 0) then if (me == 0) then
write(debug_unit,*) trim(name),& 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 ! This is awkward, we are saving the aggregation parms, for the sake
! of distr/repl matrix at coarse level. Should be rethought. ! of distr/repl matrix at coarse level. Should be rethought.
! !
athresh = p%precv(newsz)%parms%aggr_thresh athresh = prec%precv(newsz)%parms%aggr_thresh
ascale = p%precv(newsz)%parms%aggr_scale ascale = prec%precv(newsz)%parms%aggr_scale
aomega = p%precv(newsz)%parms%aggr_omega_val aomega = prec%precv(newsz)%parms%aggr_omega_val
if (info == 0) p%precv(newsz)%parms = coarseparms if (info == 0) prec%precv(newsz)%parms = coarseparms
p%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_thresh = athresh
p%precv(newsz)%parms%aggr_scale = ascale prec%precv(newsz)%parms%aggr_scale = ascale
p%precv(newsz)%parms%aggr_omega_val = aomega 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 if (newsz < i) then
! !
! We are going back and revisit a previous leve; ! We are going back and revisit a previous leve;
! recover the aggregation. ! recover the aggregation.
! !
ilaggr = p%precv(newsz)%map%iaggr ilaggr = prec%precv(newsz)%map%iaggr
nlaggr = p%precv(newsz)%map%naggr nlaggr = prec%precv(newsz)%map%naggr
call p%precv(newsz)%tprol%clone(op_prol,info) call prec%precv(newsz)%tprol%clone(op_prol,info)
end if end if
if (info == psb_success_) call mld_lev_mat_asb(p%precv(newsz),& if (info == psb_success_) call mld_lev_mat_asb(prec%precv(newsz),&
& p%precv(newsz-1)%base_a,p%precv(newsz-1)%base_desc,& & prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,&
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
@ -385,8 +385,8 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
endif endif
exit array_build_loop exit array_build_loop
else else
if (info == psb_success_) call mld_lev_mat_asb(p%precv(i),& if (info == psb_success_) call mld_lev_mat_asb(prec%precv(i),&
& p%precv(i-1)%base_a,p%precv(i-1)%base_desc,& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,&
& ilaggr,nlaggr,op_prol,info) & ilaggr,nlaggr,op_prol,info)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
@ -409,12 +409,12 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
goto 9999 goto 9999
endif endif
do i=1,newsz do i=1,newsz
call p%precv(i)%move_alloc(tprecv(i),info) call prec%precv(i)%move_alloc(tprecv(i),info)
end do end do
do i=newsz+1, iszv do i=newsz+1, iszv
call p%precv(i)%free(info) call prec%precv(i)%free(info)
end do end do
call move_alloc(tprecv,p%precv) call move_alloc(tprecv,prec%precv)
! Ignore errors from transfer ! Ignore errors from transfer
info = psb_success_ 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 ! Fix the pointers, but the level 1 should
! be already OK ! be already OK
do i=2, iszv do i=2, iszv
p%precv(i)%base_a => p%precv(i)%ac prec%precv(i)%base_a => prec%precv(i)%ac
p%precv(i)%base_desc => p%precv(i)%desc_ac prec%precv(i)%base_desc => prec%precv(i)%desc_ac
p%precv(i)%map%p_desc_X => p%precv(i-1)%base_desc prec%precv(i)%map%p_desc_X => prec%precv(i-1)%base_desc
p%precv(i)%map%p_desc_Y => p%precv(i)%base_desc prec%precv(i)%map%p_desc_Y => prec%precv(i)%base_desc
end do end do
end if end if
@ -436,9 +436,9 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info)
goto 9999 goto 9999
endif endif
iszv = size(p%precv) iszv = size(prec%precv)
call p%cmp_complexity() call prec%cmp_complexity()
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&

2
mlprec/impl/mld_z_lev_aggrmap_bld.f90
Unescape Escape View File

@ -1,3 +1,4 @@
! !
! !
! MLD2P4 version 2.1 ! MLD2P4 version 2.1
@ -77,6 +78,7 @@
subroutine mld_z_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info) subroutine mld_z_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_z_inner_mod, mld_protect_name => mld_z_lev_aggrmap_bld use mld_z_inner_mod, mld_protect_name => mld_z_lev_aggrmap_bld
implicit none implicit none

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

@ -88,6 +88,7 @@
subroutine mld_z_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) subroutine mld_z_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_z_inner_mod, mld_protect_name => mld_z_lev_aggrmat_asb use mld_z_inner_mod, mld_protect_name => mld_z_lev_aggrmat_asb
implicit none implicit none

14
mlprec/impl/mld_z_smoothers_bld.f90
Unescape Escape View File

@ -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 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 use mld_z_prec_mod, mld_protect_name => mld_z_smoothers_bld
Implicit None Implicit None
@ -90,7 +90,7 @@ subroutine mld_z_smoothers_bld(a,desc_a,p,info,amold,vmold,imold)
! Arguments ! Arguments
type(psb_zspmat_type),intent(in), target :: a type(psb_zspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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 integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold 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 ! !$ endif
upd_ = 'F' upd_ = 'F'
if (.not.allocated(p%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_zprecinit !! Error: should have called mld_zprecinit
info=3111 info=3111
call psb_errpush(info,name) 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 ! Check to ensure all procs have the same
! !
iszv = size(p%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999 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 ! 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 if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Error @ level',i write(ch_err,'(a,i7)') 'Error @ level',i

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

@ -88,6 +88,7 @@
subroutine mld_zaggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info) subroutine mld_zaggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_z_inner_mod, mld_protect_name => mld_zaggrmap_bld use mld_z_inner_mod, mld_protect_name => mld_zaggrmap_bld
implicit none implicit none

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

@ -120,6 +120,7 @@
subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_asb use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_asb
implicit none implicit none

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

@ -84,6 +84,7 @@
! !
subroutine mld_zaggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_zaggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_biz_asb use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_biz_asb
implicit none implicit none

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

@ -112,6 +112,7 @@
! !
subroutine mld_zaggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_zaggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_minnrg_asb use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_minnrg_asb
implicit none implicit none

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

@ -100,6 +100,7 @@
! !
subroutine mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_nosmth_asb use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_nosmth_asb
implicit none implicit none

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

@ -113,6 +113,7 @@
! !
subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_smth_asb use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_smth_asb
implicit none implicit none

2
mlprec/impl/mld_zmlprec_aply.f90
Unescape Escape View File

@ -299,6 +299,7 @@
subroutine mld_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) subroutine mld_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_z_inner_mod, mld_protect_name => mld_zmlprec_aply_vect use mld_z_inner_mod, mld_protect_name => mld_zmlprec_aply_vect
implicit none 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) subroutine mld_zmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type
use mld_z_inner_mod, mld_protect_name => mld_zmlprec_aply use mld_z_inner_mod, mld_protect_name => mld_zmlprec_aply
implicit none implicit none

4
mlprec/impl/mld_zmlprec_bld.f90
Unescape Escape View File

@ -123,7 +123,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
call mld_z_hierarchy_bld(a,desc_a,p,info) call p%hierarchy_build(a,desc_a,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_internal_error_ 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() 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 if (info /= psb_success_) then
info=psb_err_internal_error_ info=psb_err_internal_error_

10
mlprec/impl/mld_zprecaply.f90
Unescape Escape View File

@ -75,7 +75,7 @@
subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work) subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod 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 implicit none
@ -206,7 +206,7 @@ end subroutine mld_zprecaply
subroutine mld_zprecaply1(prec,x,desc_data,info,trans) subroutine mld_zprecaply1(prec,x,desc_data,info,trans)
use psb_base_mod 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 implicit none
@ -240,7 +240,7 @@ subroutine mld_zprecaply1(prec,x,desc_data,info,trans)
goto 9999 goto 9999
end if 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 if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precaply') call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_precaply')
goto 9999 goto 9999
@ -267,7 +267,7 @@ end subroutine mld_zprecaply1
subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work) subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
use psb_base_mod 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 implicit none
@ -368,7 +368,7 @@ end subroutine mld_zprecaply2_vect
subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work) subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
use psb_base_mod 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 implicit none

70
mlprec/impl/mld_zprecbld.f90
Unescape Escape View File

@ -59,10 +59,9 @@
! info - integer, output. ! info - integer, output.
! Error code. ! 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 psb_base_mod
use mld_z_inner_mod
use mld_z_prec_mod, mld_protect_name => mld_zprecbld use mld_z_prec_mod, mld_protect_name => mld_zprecbld
Implicit None Implicit None
@ -70,7 +69,7 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold)
! Arguments ! Arguments
type(psb_zspmat_type),intent(in), target :: a type(psb_zspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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 integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold 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 int_err(1) = 0
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
p%ictxt = ictxt prec%ictxt = ictxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -122,7 +121,7 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold)
!!$ endif !!$ endif
upd_ = 'F' upd_ = 'F'
if (.not.allocated(p%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_zprecinit !! Error: should have called mld_zprecinit
info=3111 info=3111
call psb_errpush(info,name) 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 ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
iszv = size(p%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999 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 ! Check on the iprcparm contents: they should be the same
! on all processes. ! 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 prec%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a prec%precv(1)%base_desc => desc_a
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
goto 9999 goto 9999
end if end if
call p%precv(1)%check(info) call prec%precv(1)%check(info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) ' Smoother check error',info write(0,*) ' Smoother check error',info
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner check.') & a_err='One level preconditioner check.')
goto 9999 goto 9999
endif endif
call p%precv(1)%sm%build(a,desc_a,upd_,info,& call prec%precv(1)%sm%build(a,desc_a,upd_,info,&
& amold=amold,vmold=vmold,imold=imold) & amold=amold,vmold=vmold,imold=imold)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner build.') & a_err='One level preconditioner build.')
goto 9999 goto 9999
endif endif
! !
! Number of levels > 1 ! Number of levels > 1
@ -190,16 +189,25 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold)
! !
! Build the multilevel preconditioner ! Build the multilevel preconditioner
! !
call mld_mlprec_bld(a,desc_a,p,info,& call prec%hierarchy_build(a,desc_a,info)
& amold=amold,vmold=vmold,imold=imold)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& info=psb_err_internal_error_
& a_err='Multilevel preconditioner build.') call psb_errpush(info,name,a_err='Error from hierarchy build')
goto 9999 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 end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

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

@ -84,12 +84,8 @@
! lowercase strings). ! lowercase strings).
! info - integer, output. ! info - integer, output.
! Error code. ! 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 psb_base_mod
use mld_z_prec_mod, mld_protect_name => mld_zprecinit use mld_z_prec_mod, mld_protect_name => mld_zprecinit
@ -109,10 +105,9 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
implicit none implicit none
! Arguments ! Arguments
type(mld_zprec_type), intent(inout) :: p class(mld_zprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: nlev
! Local variables ! Local variables
integer(psb_ipk_) :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
@ -120,99 +115,94 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
if (allocated(p%precv)) then if (allocated(prec%precv)) then
call mld_precfree(p,info) call prec%free(info)
if (info /= psb_success_) then if (info /= psb_success_) then
! Do we want to do something? ! Do we want to do something?
endif endif
endif endif
p%coarse_aggr_size = -1 prec%coarse_aggr_size = -1
select case(psb_toupper(ptype(1:len_trim(ptype)))) select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NOPREC','NONE') case ('NOPREC','NONE')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
allocate(mld_z_base_smoother_type :: p%precv(ilev_)%sm, stat=info) allocate(mld_z_base_smoother_type :: prec%precv(ilev_)%sm, stat=info)
if (info /= psb_success_) return if (info /= psb_success_) return
allocate(mld_z_id_solver_type :: p%precv(ilev_)%sm%sv, stat=info) allocate(mld_z_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('JAC','DIAG','JACOBI') case ('JAC','DIAG','JACOBI')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 (info /= psb_success_) return
allocate(mld_z_diag_solver_type :: p%precv(ilev_)%sm%sv, stat=info) allocate(mld_z_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('BJAC') case ('BJAC')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('AS') case ('AS')
nlev_ = 1 nlev_ = 1
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 if (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
case ('ML') case ('ML')
if (present(nlev)) then nlev_ = prec%max_prec_levs
nlev_ = max(1,nlev)
p%max_prec_levs = nlev_
else
nlev_ = p%max_prec_levs
end if
ilev_ = 1 ilev_ = 1
allocate(p%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
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 if (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
if (nlev_ == 1) return if (nlev_ == 1) return
do ilev_ = 2, nlev_ -1 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 if (info /= psb_success_) return
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)
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
end do end do
ilev_ = nlev_ 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 (info /= psb_success_) return
#if defined(HAVE_UMF_) #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_) #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 #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 #endif
call p%precv(ilev_)%default() call prec%precv(ilev_)%default()
p%precv(ilev_)%parms%coarse_solve = mld_bjac_ prec%precv(ilev_)%parms%coarse_solve = mld_bjac_
call p%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info) call prec%precv(ilev_)%set(mld_smoother_sweeps_,4_psb_ipk_,info)
call p%precv(ilev_)%set(mld_sub_restr_,psb_none_,info) call prec%precv(ilev_)%set(mld_sub_restr_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info) call prec%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info) call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.05_psb_dpk_ thr = 0.05_psb_dpk_
scale = 1.0_psb_dpk_ scale = 1.0_psb_dpk_
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
call p%precv(ilev_)%set(mld_aggr_scale_,scale,info) call prec%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_filter_,mld_filter_mat_,info)
end do end do
case default case default

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

@ -171,7 +171,7 @@ lib: $(OBJS)
$(RANLIB) $(HERE)/$(LIBNAME) $(RANLIB) $(HERE)/$(LIBNAME)
mpobjs: mpobjs:
(make $(MPFOBJS) F90="$(MPF90)" F90COPT="$(F90COPT)") (make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)")
(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)") (make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
veryclean: clean veryclean: clean

2
mlprec/impl/solver/Makefile
Unescape Escape View File

@ -184,7 +184,7 @@ lib: $(OBJS)
$(RANLIB) $(HERE)/$(LIBNAME) $(RANLIB) $(HERE)/$(LIBNAME)
mpobjs: mpobjs:
(make $(MPFOBJS) F90="$(MPF90)" F90COPT="$(F90COPT)") (make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)")
(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)") (make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
veryclean: clean veryclean: clean

39
mlprec/mld_c_inner_mod.f90
Unescape Escape View File

@ -46,13 +46,17 @@
! The interfaces of the user level routines are defined in mld_prec_mod.f90. ! The interfaces of the user level routines are defined in mld_prec_mod.f90.
! !
module mld_c_inner_mod 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 interface mld_mlprec_bld
subroutine mld_cmlprec_bld(a,desc_a,prec,info, amold, vmold,imold) 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_ & 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 implicit none
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
! !$ character, intent(in),optional :: upd
end subroutine mld_cmlprec_bld end subroutine mld_cmlprec_bld
end interface mld_mlprec_bld end interface mld_mlprec_bld
interface mld_mlprec_aply interface mld_mlprec_aply
subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) 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_ import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_c_prec_type, only : mld_cprec_type import :: mld_cprec_type
implicit none implicit none
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
@ -80,9 +83,9 @@ module mld_c_inner_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_cmlprec_aply end subroutine mld_cmlprec_aply
subroutine mld_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) 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_ & psb_spk_, psb_c_vect_type, psb_ipk_
use mld_c_prec_type, only : mld_cprec_type import :: mld_cprec_type
implicit none implicit none
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
@ -97,8 +100,8 @@ module mld_c_inner_mod
interface mld_aggrmap_bld interface mld_aggrmap_bld
subroutine mld_c_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info) 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_ import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_c_prec_type, only : mld_c_onelev_type import :: mld_c_onelev_type
implicit none implicit none
type(mld_c_onelev_type), intent(inout), target :: p type(mld_c_onelev_type), intent(inout), target :: p
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
@ -108,7 +111,7 @@ module mld_c_inner_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_lev_aggrmap_bld end subroutine mld_c_lev_aggrmap_bld
subroutine mld_caggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info) 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 implicit none
integer(psb_ipk_), intent(in) :: iorder integer(psb_ipk_), intent(in) :: iorder
integer(psb_ipk_), intent(in) :: aggr_type integer(psb_ipk_), intent(in) :: aggr_type
@ -124,7 +127,7 @@ module mld_c_inner_mod
interface mld_dec_map_bld interface mld_dec_map_bld
subroutine mld_c_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) 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 implicit none
integer(psb_ipk_), intent(in) :: iorder integer(psb_ipk_), intent(in) :: iorder
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
@ -138,8 +141,8 @@ module mld_c_inner_mod
interface mld_lev_mat_asb interface mld_lev_mat_asb
subroutine mld_c_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) 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_ import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_c_prec_type, only : mld_c_onelev_type import :: mld_c_onelev_type
implicit none implicit none
type(mld_c_onelev_type), intent(inout), target :: p type(mld_c_onelev_type), intent(inout), target :: p
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
@ -152,8 +155,8 @@ module mld_c_inner_mod
interface mld_aggrmat_asb interface mld_aggrmat_asb
subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) 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_ import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_c_prec_type, only : mld_sml_parms import :: mld_sml_parms
implicit none implicit none
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -166,8 +169,8 @@ module mld_c_inner_mod
abstract interface abstract interface
subroutine mld_caggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) 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_ import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_c_prec_type, only : mld_c_onelev_type, mld_sml_parms import :: mld_c_onelev_type, mld_sml_parms
implicit none implicit none
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a

2
mlprec/mld_c_onelev_mod.f90
Unescape Escape View File

@ -435,7 +435,7 @@ contains
lv%parms%sweeps = 1 lv%parms%sweeps = 1
lv%parms%sweeps_pre = 1 lv%parms%sweeps_pre = 1
lv%parms%sweeps_post = 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_alg = mld_dec_aggr_
lv%parms%aggr_ord = mld_aggr_ord_nat_ lv%parms%aggr_ord = mld_aggr_ord_nat_
lv%parms%aggr_kind = mld_smooth_prol_ lv%parms%aggr_kind = mld_smooth_prol_

58
mlprec/mld_c_prec_mod.f90
Unescape Escape View File

@ -54,53 +54,12 @@ module mld_c_prec_mod
use mld_c_ilu_solver use mld_c_ilu_solver
use mld_c_gs_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 interface mld_precset
module procedure mld_c_iprecsetsm, mld_c_iprecsetsv, & module procedure mld_c_iprecsetsm, mld_c_iprecsetsv, &
& mld_c_iprecseti, mld_c_iprecsetc, mld_c_iprecsetr, & & mld_c_iprecseti, mld_c_iprecsetc, mld_c_iprecsetr, &
& mld_c_cprecseti, mld_c_cprecsetc, mld_c_cprecsetr & mld_c_cprecseti, mld_c_cprecsetc, mld_c_cprecsetr
end interface mld_precset 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 interface mld_extprol_bld
subroutine mld_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold) subroutine mld_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, & 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 subroutine mld_c_extprol_bld
end interface mld_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 contains
subroutine mld_c_iprecsetsm(p,val,info,pos) subroutine mld_c_iprecsetsm(p,val,info,pos)

107
mlprec/mld_c_prec_type.f90
Unescape Escape View File

@ -136,6 +136,11 @@ module mld_c_prec_type
procedure, pass(prec) :: get_smoother => mld_c_get_smootherp procedure, pass(prec) :: get_smoother => mld_c_get_smootherp
procedure, pass(prec) :: get_solver => mld_c_get_solverp procedure, pass(prec) :: get_solver => mld_c_get_solverp
procedure, pass(prec) :: move_alloc => c_prec_move_alloc 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 end type mld_cprec_type
private :: mld_c_dump, mld_c_get_compl, mld_c_cmp_compl,& 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 module procedure mld_cprec_sizeof
end interface end interface
interface mld_precaply interface mld_precapply
subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work) subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
import :: psb_cspmat_type, psb_desc_type, & import :: psb_cspmat_type, psb_desc_type, &
& psb_spk_, psb_c_vect_type, mld_cprec_type, psb_ipk_ & 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 subroutine mld_ccprecsetc
end interface 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 contains
! !
! Function returning a pointer to the smoother ! 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. ! The id of the process printing the message; -1 acts as a wildcard.
! Default is psb_root_ ! Default is psb_root_
! !
subroutine mld_cfile_prec_descr(p,info,iout,root) subroutine mld_cfile_prec_descr(prec,iout,root)
implicit none implicit none
! Arguments ! Arguments
type(mld_cprec_type), intent(in) :: p class(mld_cprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
! Local variables ! Local variables
integer(psb_ipk_) :: ilev, nlev, ilmin integer(psb_ipk_) :: ilev, nlev, ilmin, info
integer(psb_ipk_) :: ictxt, me, np integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr' character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
@ -473,9 +534,9 @@ contains
end if end if
if (iout_ < 0) iout_ = 6 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) call psb_info(ictxt,me,np)
if (present(root)) then if (present(root)) then
@ -492,9 +553,9 @@ contains
! ensured by mld_precbld). ! ensured by mld_precbld).
! !
if (me == root_) then if (me == root_) then
nlev = size(p%precv) nlev = size(prec%precv)
do ilev = 1, nlev do ilev = 1, nlev
if (.not.allocated(p%precv(ilev)%sm)) then if (.not.allocated(prec%precv(ilev)%sm)) then
info = 3111 info = 3111
write(iout_,*) ' ',name,& write(iout_,*) ' ',name,&
& ': error: inconsistent MLPREC part, should call MLD_PRECINIT' & ': error: inconsistent MLPREC part, should call MLD_PRECINIT'
@ -510,26 +571,26 @@ contains
! !
if (nlev > 1) then if (nlev > 1) then
write(iout_,*) 'Multilevel Preconditioner' write(iout_,*) 'Multilevel Preconditioner'
write(iout_,*) 'Outer sweeps:',p%outer_sweeps write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
write(iout_,*) write(iout_,*)
write(iout_,*) 'Base preconditioner (smoother) details' write(iout_,*) 'Base preconditioner (smoother) details'
endif endif
call p%precv(1)%sm%descr(info,iout=iout_) call prec%precv(1)%sm%descr(info,iout=iout_)
if (nlev == 1) then 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 : ',& write(iout_,*) ' Number of smoother sweeps : ',&
& p%precv(1)%parms%sweeps & prec%precv(1)%parms%sweeps
end if end if
write(iout_,*) write(iout_,*)
return return
end if end if
if (allocated(p%precv(1)%sm2a)) then if (allocated(prec%precv(1)%sm2a)) then
write(iout_,*) 'Post smoother details' 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 (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 : ',& write(iout_,*) ' Number of smoother sweeps : ',&
& p%precv(1)%parms%sweeps & prec%precv(1)%parms%sweeps
end if end if
write(iout_,*) write(iout_,*)
return return
@ -543,11 +604,11 @@ contains
write(iout_,*) write(iout_,*)
write(iout_,*) 'Multilevel details' write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels : ',nlev write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity() write(iout_,*) ' Operator complexity: ',prec%get_complexity()
ilmin = 2 ilmin = 2
if (nlev == 2) ilmin=1 if (nlev == 2) ilmin=1
do ilev=ilmin,nlev 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 end do
write(iout_,*) write(iout_,*)
@ -656,7 +717,7 @@ contains
select type(prec) select type(prec)
type is (mld_cprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -686,7 +747,7 @@ contains
select type(prec) select type(prec)
type is (mld_cprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -718,7 +779,7 @@ contains
select type(prec) select type(prec)
type is (mld_cprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -747,7 +808,7 @@ contains
select type(prec) select type(prec)
type is (mld_cprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)

39
mlprec/mld_d_inner_mod.f90
Unescape Escape View File

@ -46,13 +46,17 @@
! The interfaces of the user level routines are defined in mld_prec_mod.f90. ! The interfaces of the user level routines are defined in mld_prec_mod.f90.
! !
module mld_d_inner_mod 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 interface mld_mlprec_bld
subroutine mld_dmlprec_bld(a,desc_a,prec,info, amold, vmold,imold) 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_ & 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 implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
! !$ character, intent(in),optional :: upd
end subroutine mld_dmlprec_bld end subroutine mld_dmlprec_bld
end interface mld_mlprec_bld end interface mld_mlprec_bld
interface mld_mlprec_aply interface mld_mlprec_aply
subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) 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_ import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_d_prec_type, only : mld_dprec_type import :: mld_dprec_type
implicit none implicit none
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
@ -80,9 +83,9 @@ module mld_d_inner_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_dmlprec_aply end subroutine mld_dmlprec_aply
subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) 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_ & psb_dpk_, psb_d_vect_type, psb_ipk_
use mld_d_prec_type, only : mld_dprec_type import :: mld_dprec_type
implicit none implicit none
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
@ -97,8 +100,8 @@ module mld_d_inner_mod
interface mld_aggrmap_bld interface mld_aggrmap_bld
subroutine mld_d_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info) 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_ import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_d_prec_type, only : mld_d_onelev_type import :: mld_d_onelev_type
implicit none implicit none
type(mld_d_onelev_type), intent(inout), target :: p type(mld_d_onelev_type), intent(inout), target :: p
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
@ -108,7 +111,7 @@ module mld_d_inner_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_lev_aggrmap_bld end subroutine mld_d_lev_aggrmap_bld
subroutine mld_daggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info) 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 implicit none
integer(psb_ipk_), intent(in) :: iorder integer(psb_ipk_), intent(in) :: iorder
integer(psb_ipk_), intent(in) :: aggr_type integer(psb_ipk_), intent(in) :: aggr_type
@ -124,7 +127,7 @@ module mld_d_inner_mod
interface mld_dec_map_bld interface mld_dec_map_bld
subroutine mld_d_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) 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 implicit none
integer(psb_ipk_), intent(in) :: iorder integer(psb_ipk_), intent(in) :: iorder
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
@ -138,8 +141,8 @@ module mld_d_inner_mod
interface mld_lev_mat_asb interface mld_lev_mat_asb
subroutine mld_d_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) 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_ import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_d_prec_type, only : mld_d_onelev_type import :: mld_d_onelev_type
implicit none implicit none
type(mld_d_onelev_type), intent(inout), target :: p type(mld_d_onelev_type), intent(inout), target :: p
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
@ -152,8 +155,8 @@ module mld_d_inner_mod
interface mld_aggrmat_asb interface mld_aggrmat_asb
subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) 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_ import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_d_prec_type, only : mld_dml_parms import :: mld_dml_parms
implicit none implicit none
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -166,8 +169,8 @@ module mld_d_inner_mod
abstract interface abstract interface
subroutine mld_daggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) 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_ import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_d_prec_type, only : mld_d_onelev_type, mld_dml_parms import :: mld_d_onelev_type, mld_dml_parms
implicit none implicit none
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a

2
mlprec/mld_d_onelev_mod.f90
Unescape Escape View File

@ -435,7 +435,7 @@ contains
lv%parms%sweeps = 1 lv%parms%sweeps = 1
lv%parms%sweeps_pre = 1 lv%parms%sweeps_pre = 1
lv%parms%sweeps_post = 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_alg = mld_dec_aggr_
lv%parms%aggr_ord = mld_aggr_ord_nat_ lv%parms%aggr_ord = mld_aggr_ord_nat_
lv%parms%aggr_kind = mld_smooth_prol_ lv%parms%aggr_kind = mld_smooth_prol_

58
mlprec/mld_d_prec_mod.f90
Unescape Escape View File

@ -54,53 +54,12 @@ module mld_d_prec_mod
use mld_d_ilu_solver use mld_d_ilu_solver
use mld_d_gs_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 interface mld_precset
module procedure mld_d_iprecsetsm, mld_d_iprecsetsv, & module procedure mld_d_iprecsetsm, mld_d_iprecsetsv, &
& mld_d_iprecseti, mld_d_iprecsetc, mld_d_iprecsetr, & & mld_d_iprecseti, mld_d_iprecsetc, mld_d_iprecsetr, &
& mld_d_cprecseti, mld_d_cprecsetc, mld_d_cprecsetr & mld_d_cprecseti, mld_d_cprecsetc, mld_d_cprecsetr
end interface mld_precset 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 interface mld_extprol_bld
subroutine mld_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold) subroutine mld_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & 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 subroutine mld_d_extprol_bld
end interface mld_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 contains
subroutine mld_d_iprecsetsm(p,val,info,pos) subroutine mld_d_iprecsetsm(p,val,info,pos)

122
mlprec/mld_d_prec_type.f90
Unescape Escape View File

@ -136,28 +136,16 @@ module mld_d_prec_type
procedure, pass(prec) :: get_smoother => mld_d_get_smootherp procedure, pass(prec) :: get_smoother => mld_d_get_smootherp
procedure, pass(prec) :: get_solver => mld_d_get_solverp procedure, pass(prec) :: get_solver => mld_d_get_solverp
procedure, pass(prec) :: move_alloc => d_prec_move_alloc procedure, pass(prec) :: move_alloc => d_prec_move_alloc
procedure, pass(prec) :: init => mld_dprecinit
procedure, pass(prec) :: build => mld_dprecbld 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 end type mld_dprec_type
private :: mld_d_dump, mld_d_get_compl, mld_d_cmp_compl,& private :: mld_d_dump, mld_d_get_compl, mld_d_cmp_compl,&
& mld_d_get_nzeros, mld_d_get_nlevs, d_prec_move_alloc & 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, ! Interfaces to routines for checking the definition of the preconditioner,
@ -177,7 +165,7 @@ module mld_d_prec_type
module procedure mld_dprec_sizeof module procedure mld_dprec_sizeof
end interface end interface
interface mld_precaply interface mld_precapply
subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work) subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
import :: psb_dspmat_type, psb_desc_type, & import :: psb_dspmat_type, psb_desc_type, &
& psb_dpk_, psb_d_vect_type, mld_dprec_type, psb_ipk_ & 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 subroutine mld_dcprecsetc
end interface 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 contains
! !
! Function returning a pointer to the smoother ! 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. ! The id of the process printing the message; -1 acts as a wildcard.
! Default is psb_root_ ! Default is psb_root_
! !
subroutine mld_dfile_prec_descr(p,info,iout,root) subroutine mld_dfile_prec_descr(prec,iout,root)
implicit none implicit none
! Arguments ! Arguments
type(mld_dprec_type), intent(in) :: p class(mld_dprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
! Local variables ! Local variables
integer(psb_ipk_) :: ilev, nlev, ilmin integer(psb_ipk_) :: ilev, nlev, ilmin, info
integer(psb_ipk_) :: ictxt, me, np integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr' character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
@ -490,9 +534,9 @@ contains
end if end if
if (iout_ < 0) iout_ = 6 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) call psb_info(ictxt,me,np)
if (present(root)) then if (present(root)) then
@ -509,9 +553,9 @@ contains
! ensured by mld_precbld). ! ensured by mld_precbld).
! !
if (me == root_) then if (me == root_) then
nlev = size(p%precv) nlev = size(prec%precv)
do ilev = 1, nlev do ilev = 1, nlev
if (.not.allocated(p%precv(ilev)%sm)) then if (.not.allocated(prec%precv(ilev)%sm)) then
info = 3111 info = 3111
write(iout_,*) ' ',name,& write(iout_,*) ' ',name,&
& ': error: inconsistent MLPREC part, should call MLD_PRECINIT' & ': error: inconsistent MLPREC part, should call MLD_PRECINIT'
@ -527,26 +571,26 @@ contains
! !
if (nlev > 1) then if (nlev > 1) then
write(iout_,*) 'Multilevel Preconditioner' write(iout_,*) 'Multilevel Preconditioner'
write(iout_,*) 'Outer sweeps:',p%outer_sweeps write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
write(iout_,*) write(iout_,*)
write(iout_,*) 'Base preconditioner (smoother) details' write(iout_,*) 'Base preconditioner (smoother) details'
endif endif
call p%precv(1)%sm%descr(info,iout=iout_) call prec%precv(1)%sm%descr(info,iout=iout_)
if (nlev == 1) then 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 : ',& write(iout_,*) ' Number of smoother sweeps : ',&
& p%precv(1)%parms%sweeps & prec%precv(1)%parms%sweeps
end if end if
write(iout_,*) write(iout_,*)
return return
end if end if
if (allocated(p%precv(1)%sm2a)) then if (allocated(prec%precv(1)%sm2a)) then
write(iout_,*) 'Post smoother details' 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 (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 : ',& write(iout_,*) ' Number of smoother sweeps : ',&
& p%precv(1)%parms%sweeps & prec%precv(1)%parms%sweeps
end if end if
write(iout_,*) write(iout_,*)
return return
@ -560,11 +604,11 @@ contains
write(iout_,*) write(iout_,*)
write(iout_,*) 'Multilevel details' write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels : ',nlev write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity() write(iout_,*) ' Operator complexity: ',prec%get_complexity()
ilmin = 2 ilmin = 2
if (nlev == 2) ilmin=1 if (nlev == 2) ilmin=1
do ilev=ilmin,nlev 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 end do
write(iout_,*) write(iout_,*)
@ -673,7 +717,7 @@ contains
select type(prec) select type(prec)
type is (mld_dprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -703,7 +747,7 @@ contains
select type(prec) select type(prec)
type is (mld_dprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -735,7 +779,7 @@ contains
select type(prec) select type(prec)
type is (mld_dprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -764,7 +808,7 @@ contains
select type(prec) select type(prec)
type is (mld_dprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)

39
mlprec/mld_s_inner_mod.f90
Unescape Escape View File

@ -46,13 +46,17 @@
! The interfaces of the user level routines are defined in mld_prec_mod.f90. ! The interfaces of the user level routines are defined in mld_prec_mod.f90.
! !
module mld_s_inner_mod 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 interface mld_mlprec_bld
subroutine mld_smlprec_bld(a,desc_a,prec,info, amold, vmold,imold) 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_ & 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 implicit none
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
! !$ character, intent(in),optional :: upd
end subroutine mld_smlprec_bld end subroutine mld_smlprec_bld
end interface mld_mlprec_bld end interface mld_mlprec_bld
interface mld_mlprec_aply interface mld_mlprec_aply
subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) 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_ import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_s_prec_type, only : mld_sprec_type import :: mld_sprec_type
implicit none implicit none
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
@ -80,9 +83,9 @@ module mld_s_inner_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_smlprec_aply end subroutine mld_smlprec_aply
subroutine mld_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) 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_ & psb_spk_, psb_s_vect_type, psb_ipk_
use mld_s_prec_type, only : mld_sprec_type import :: mld_sprec_type
implicit none implicit none
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
@ -97,8 +100,8 @@ module mld_s_inner_mod
interface mld_aggrmap_bld interface mld_aggrmap_bld
subroutine mld_s_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info) 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_ import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_s_prec_type, only : mld_s_onelev_type import :: mld_s_onelev_type
implicit none implicit none
type(mld_s_onelev_type), intent(inout), target :: p type(mld_s_onelev_type), intent(inout), target :: p
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a
@ -108,7 +111,7 @@ module mld_s_inner_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_lev_aggrmap_bld end subroutine mld_s_lev_aggrmap_bld
subroutine mld_saggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info) 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 implicit none
integer(psb_ipk_), intent(in) :: iorder integer(psb_ipk_), intent(in) :: iorder
integer(psb_ipk_), intent(in) :: aggr_type integer(psb_ipk_), intent(in) :: aggr_type
@ -124,7 +127,7 @@ module mld_s_inner_mod
interface mld_dec_map_bld interface mld_dec_map_bld
subroutine mld_s_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) 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 implicit none
integer(psb_ipk_), intent(in) :: iorder integer(psb_ipk_), intent(in) :: iorder
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a
@ -138,8 +141,8 @@ module mld_s_inner_mod
interface mld_lev_mat_asb interface mld_lev_mat_asb
subroutine mld_s_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) 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_ import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_s_prec_type, only : mld_s_onelev_type import :: mld_s_onelev_type
implicit none implicit none
type(mld_s_onelev_type), intent(inout), target :: p type(mld_s_onelev_type), intent(inout), target :: p
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a
@ -152,8 +155,8 @@ module mld_s_inner_mod
interface mld_aggrmat_asb interface mld_aggrmat_asb
subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) 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_ import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_s_prec_type, only : mld_sml_parms import :: mld_sml_parms
implicit none implicit none
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -166,8 +169,8 @@ module mld_s_inner_mod
abstract interface abstract interface
subroutine mld_saggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) 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_ import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
use mld_s_prec_type, only : mld_s_onelev_type, mld_sml_parms import :: mld_s_onelev_type, mld_sml_parms
implicit none implicit none
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a

2
mlprec/mld_s_onelev_mod.f90
Unescape Escape View File

@ -435,7 +435,7 @@ contains
lv%parms%sweeps = 1 lv%parms%sweeps = 1
lv%parms%sweeps_pre = 1 lv%parms%sweeps_pre = 1
lv%parms%sweeps_post = 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_alg = mld_dec_aggr_
lv%parms%aggr_ord = mld_aggr_ord_nat_ lv%parms%aggr_ord = mld_aggr_ord_nat_
lv%parms%aggr_kind = mld_smooth_prol_ lv%parms%aggr_kind = mld_smooth_prol_

58
mlprec/mld_s_prec_mod.f90
Unescape Escape View File

@ -54,53 +54,12 @@ module mld_s_prec_mod
use mld_s_ilu_solver use mld_s_ilu_solver
use mld_s_gs_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 interface mld_precset
module procedure mld_s_iprecsetsm, mld_s_iprecsetsv, & module procedure mld_s_iprecsetsm, mld_s_iprecsetsv, &
& mld_s_iprecseti, mld_s_iprecsetc, mld_s_iprecsetr, & & mld_s_iprecseti, mld_s_iprecsetc, mld_s_iprecsetr, &
& mld_s_cprecseti, mld_s_cprecsetc, mld_s_cprecsetr & mld_s_cprecseti, mld_s_cprecsetc, mld_s_cprecsetr
end interface mld_precset 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 interface mld_extprol_bld
subroutine mld_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold) subroutine mld_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, & 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 subroutine mld_s_extprol_bld
end interface mld_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 contains
subroutine mld_s_iprecsetsm(p,val,info,pos) subroutine mld_s_iprecsetsm(p,val,info,pos)

107
mlprec/mld_s_prec_type.f90
Unescape Escape View File

@ -136,6 +136,11 @@ module mld_s_prec_type
procedure, pass(prec) :: get_smoother => mld_s_get_smootherp procedure, pass(prec) :: get_smoother => mld_s_get_smootherp
procedure, pass(prec) :: get_solver => mld_s_get_solverp procedure, pass(prec) :: get_solver => mld_s_get_solverp
procedure, pass(prec) :: move_alloc => s_prec_move_alloc 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 end type mld_sprec_type
private :: mld_s_dump, mld_s_get_compl, mld_s_cmp_compl,& 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 module procedure mld_sprec_sizeof
end interface end interface
interface mld_precaply interface mld_precapply
subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work) subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
import :: psb_sspmat_type, psb_desc_type, & import :: psb_sspmat_type, psb_desc_type, &
& psb_spk_, psb_s_vect_type, mld_sprec_type, psb_ipk_ & 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 subroutine mld_scprecsetc
end interface 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 contains
! !
! Function returning a pointer to the smoother ! 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. ! The id of the process printing the message; -1 acts as a wildcard.
! Default is psb_root_ ! Default is psb_root_
! !
subroutine mld_sfile_prec_descr(p,info,iout,root) subroutine mld_sfile_prec_descr(prec,iout,root)
implicit none implicit none
! Arguments ! Arguments
type(mld_sprec_type), intent(in) :: p class(mld_sprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
! Local variables ! Local variables
integer(psb_ipk_) :: ilev, nlev, ilmin integer(psb_ipk_) :: ilev, nlev, ilmin, info
integer(psb_ipk_) :: ictxt, me, np integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr' character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
@ -473,9 +534,9 @@ contains
end if end if
if (iout_ < 0) iout_ = 6 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) call psb_info(ictxt,me,np)
if (present(root)) then if (present(root)) then
@ -492,9 +553,9 @@ contains
! ensured by mld_precbld). ! ensured by mld_precbld).
! !
if (me == root_) then if (me == root_) then
nlev = size(p%precv) nlev = size(prec%precv)
do ilev = 1, nlev do ilev = 1, nlev
if (.not.allocated(p%precv(ilev)%sm)) then if (.not.allocated(prec%precv(ilev)%sm)) then
info = 3111 info = 3111
write(iout_,*) ' ',name,& write(iout_,*) ' ',name,&
& ': error: inconsistent MLPREC part, should call MLD_PRECINIT' & ': error: inconsistent MLPREC part, should call MLD_PRECINIT'
@ -510,26 +571,26 @@ contains
! !
if (nlev > 1) then if (nlev > 1) then
write(iout_,*) 'Multilevel Preconditioner' write(iout_,*) 'Multilevel Preconditioner'
write(iout_,*) 'Outer sweeps:',p%outer_sweeps write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
write(iout_,*) write(iout_,*)
write(iout_,*) 'Base preconditioner (smoother) details' write(iout_,*) 'Base preconditioner (smoother) details'
endif endif
call p%precv(1)%sm%descr(info,iout=iout_) call prec%precv(1)%sm%descr(info,iout=iout_)
if (nlev == 1) then 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 : ',& write(iout_,*) ' Number of smoother sweeps : ',&
& p%precv(1)%parms%sweeps & prec%precv(1)%parms%sweeps
end if end if
write(iout_,*) write(iout_,*)
return return
end if end if
if (allocated(p%precv(1)%sm2a)) then if (allocated(prec%precv(1)%sm2a)) then
write(iout_,*) 'Post smoother details' 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 (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 : ',& write(iout_,*) ' Number of smoother sweeps : ',&
& p%precv(1)%parms%sweeps & prec%precv(1)%parms%sweeps
end if end if
write(iout_,*) write(iout_,*)
return return
@ -543,11 +604,11 @@ contains
write(iout_,*) write(iout_,*)
write(iout_,*) 'Multilevel details' write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels : ',nlev write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity() write(iout_,*) ' Operator complexity: ',prec%get_complexity()
ilmin = 2 ilmin = 2
if (nlev == 2) ilmin=1 if (nlev == 2) ilmin=1
do ilev=ilmin,nlev 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 end do
write(iout_,*) write(iout_,*)
@ -656,7 +717,7 @@ contains
select type(prec) select type(prec)
type is (mld_sprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -686,7 +747,7 @@ contains
select type(prec) select type(prec)
type is (mld_sprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -718,7 +779,7 @@ contains
select type(prec) select type(prec)
type is (mld_sprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -747,7 +808,7 @@ contains
select type(prec) select type(prec)
type is (mld_sprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)

39
mlprec/mld_z_inner_mod.f90
Unescape Escape View File

@ -46,13 +46,17 @@
! The interfaces of the user level routines are defined in mld_prec_mod.f90. ! The interfaces of the user level routines are defined in mld_prec_mod.f90.
! !
module mld_z_inner_mod 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 interface mld_mlprec_bld
subroutine mld_zmlprec_bld(a,desc_a,prec,info, amold, vmold,imold) 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_ & 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 implicit none
type(psb_zspmat_type), intent(in), target :: a type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_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_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
! !$ character, intent(in),optional :: upd
end subroutine mld_zmlprec_bld end subroutine mld_zmlprec_bld
end interface mld_mlprec_bld end interface mld_mlprec_bld
interface mld_mlprec_aply interface mld_mlprec_aply
subroutine mld_zmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) 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_ import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_z_prec_type, only : mld_zprec_type import :: mld_zprec_type
implicit none implicit none
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
@ -80,9 +83,9 @@ module mld_z_inner_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_zmlprec_aply end subroutine mld_zmlprec_aply
subroutine mld_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) 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_ & psb_dpk_, psb_z_vect_type, psb_ipk_
use mld_z_prec_type, only : mld_zprec_type import :: mld_zprec_type
implicit none implicit none
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
@ -97,8 +100,8 @@ module mld_z_inner_mod
interface mld_aggrmap_bld interface mld_aggrmap_bld
subroutine mld_z_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info) 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_ import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_z_prec_type, only : mld_z_onelev_type import :: mld_z_onelev_type
implicit none implicit none
type(mld_z_onelev_type), intent(inout), target :: p type(mld_z_onelev_type), intent(inout), target :: p
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
@ -108,7 +111,7 @@ module mld_z_inner_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_lev_aggrmap_bld end subroutine mld_z_lev_aggrmap_bld
subroutine mld_zaggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info) 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 implicit none
integer(psb_ipk_), intent(in) :: iorder integer(psb_ipk_), intent(in) :: iorder
integer(psb_ipk_), intent(in) :: aggr_type integer(psb_ipk_), intent(in) :: aggr_type
@ -124,7 +127,7 @@ module mld_z_inner_mod
interface mld_dec_map_bld interface mld_dec_map_bld
subroutine mld_z_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) 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 implicit none
integer(psb_ipk_), intent(in) :: iorder integer(psb_ipk_), intent(in) :: iorder
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
@ -138,8 +141,8 @@ module mld_z_inner_mod
interface mld_lev_mat_asb interface mld_lev_mat_asb
subroutine mld_z_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) 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_ import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_z_prec_type, only : mld_z_onelev_type import :: mld_z_onelev_type
implicit none implicit none
type(mld_z_onelev_type), intent(inout), target :: p type(mld_z_onelev_type), intent(inout), target :: p
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
@ -152,8 +155,8 @@ module mld_z_inner_mod
interface mld_aggrmat_asb interface mld_aggrmat_asb
subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) 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_ import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_z_prec_type, only : mld_dml_parms import :: mld_dml_parms
implicit none implicit none
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
@ -166,8 +169,8 @@ module mld_z_inner_mod
abstract interface abstract interface
subroutine mld_zaggrmat_var_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) 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_ import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
use mld_z_prec_type, only : mld_z_onelev_type, mld_dml_parms import :: mld_z_onelev_type, mld_dml_parms
implicit none implicit none
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a

2
mlprec/mld_z_onelev_mod.f90
Unescape Escape View File

@ -435,7 +435,7 @@ contains
lv%parms%sweeps = 1 lv%parms%sweeps = 1
lv%parms%sweeps_pre = 1 lv%parms%sweeps_pre = 1
lv%parms%sweeps_post = 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_alg = mld_dec_aggr_
lv%parms%aggr_ord = mld_aggr_ord_nat_ lv%parms%aggr_ord = mld_aggr_ord_nat_
lv%parms%aggr_kind = mld_smooth_prol_ lv%parms%aggr_kind = mld_smooth_prol_

58
mlprec/mld_z_prec_mod.f90
Unescape Escape View File

@ -54,53 +54,12 @@ module mld_z_prec_mod
use mld_z_ilu_solver use mld_z_ilu_solver
use mld_z_gs_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 interface mld_precset
module procedure mld_z_iprecsetsm, mld_z_iprecsetsv, & module procedure mld_z_iprecsetsm, mld_z_iprecsetsv, &
& mld_z_iprecseti, mld_z_iprecsetc, mld_z_iprecsetr, & & mld_z_iprecseti, mld_z_iprecsetc, mld_z_iprecsetr, &
& mld_z_cprecseti, mld_z_cprecsetc, mld_z_cprecsetr & mld_z_cprecseti, mld_z_cprecsetc, mld_z_cprecsetr
end interface mld_precset 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 interface mld_extprol_bld
subroutine mld_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold) subroutine mld_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & 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 subroutine mld_z_extprol_bld
end interface mld_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 contains
subroutine mld_z_iprecsetsm(p,val,info,pos) subroutine mld_z_iprecsetsm(p,val,info,pos)

107
mlprec/mld_z_prec_type.f90
Unescape Escape View File

@ -136,6 +136,11 @@ module mld_z_prec_type
procedure, pass(prec) :: get_smoother => mld_z_get_smootherp procedure, pass(prec) :: get_smoother => mld_z_get_smootherp
procedure, pass(prec) :: get_solver => mld_z_get_solverp procedure, pass(prec) :: get_solver => mld_z_get_solverp
procedure, pass(prec) :: move_alloc => z_prec_move_alloc 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 end type mld_zprec_type
private :: mld_z_dump, mld_z_get_compl, mld_z_cmp_compl,& 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 module procedure mld_zprec_sizeof
end interface end interface
interface mld_precaply interface mld_precapply
subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work) subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
import :: psb_zspmat_type, psb_desc_type, & import :: psb_zspmat_type, psb_desc_type, &
& psb_dpk_, psb_z_vect_type, mld_zprec_type, psb_ipk_ & 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 subroutine mld_zcprecsetc
end interface 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 contains
! !
! Function returning a pointer to the smoother ! 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. ! The id of the process printing the message; -1 acts as a wildcard.
! Default is psb_root_ ! Default is psb_root_
! !
subroutine mld_zfile_prec_descr(p,info,iout,root) subroutine mld_zfile_prec_descr(prec,iout,root)
implicit none implicit none
! Arguments ! Arguments
type(mld_zprec_type), intent(in) :: p class(mld_zprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
! Local variables ! Local variables
integer(psb_ipk_) :: ilev, nlev, ilmin integer(psb_ipk_) :: ilev, nlev, ilmin, info
integer(psb_ipk_) :: ictxt, me, np integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr' character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
@ -473,9 +534,9 @@ contains
end if end if
if (iout_ < 0) iout_ = 6 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) call psb_info(ictxt,me,np)
if (present(root)) then if (present(root)) then
@ -492,9 +553,9 @@ contains
! ensured by mld_precbld). ! ensured by mld_precbld).
! !
if (me == root_) then if (me == root_) then
nlev = size(p%precv) nlev = size(prec%precv)
do ilev = 1, nlev do ilev = 1, nlev
if (.not.allocated(p%precv(ilev)%sm)) then if (.not.allocated(prec%precv(ilev)%sm)) then
info = 3111 info = 3111
write(iout_,*) ' ',name,& write(iout_,*) ' ',name,&
& ': error: inconsistent MLPREC part, should call MLD_PRECINIT' & ': error: inconsistent MLPREC part, should call MLD_PRECINIT'
@ -510,26 +571,26 @@ contains
! !
if (nlev > 1) then if (nlev > 1) then
write(iout_,*) 'Multilevel Preconditioner' write(iout_,*) 'Multilevel Preconditioner'
write(iout_,*) 'Outer sweeps:',p%outer_sweeps write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
write(iout_,*) write(iout_,*)
write(iout_,*) 'Base preconditioner (smoother) details' write(iout_,*) 'Base preconditioner (smoother) details'
endif endif
call p%precv(1)%sm%descr(info,iout=iout_) call prec%precv(1)%sm%descr(info,iout=iout_)
if (nlev == 1) then 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 : ',& write(iout_,*) ' Number of smoother sweeps : ',&
& p%precv(1)%parms%sweeps & prec%precv(1)%parms%sweeps
end if end if
write(iout_,*) write(iout_,*)
return return
end if end if
if (allocated(p%precv(1)%sm2a)) then if (allocated(prec%precv(1)%sm2a)) then
write(iout_,*) 'Post smoother details' 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 (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 : ',& write(iout_,*) ' Number of smoother sweeps : ',&
& p%precv(1)%parms%sweeps & prec%precv(1)%parms%sweeps
end if end if
write(iout_,*) write(iout_,*)
return return
@ -543,11 +604,11 @@ contains
write(iout_,*) write(iout_,*)
write(iout_,*) 'Multilevel details' write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels : ',nlev write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity() write(iout_,*) ' Operator complexity: ',prec%get_complexity()
ilmin = 2 ilmin = 2
if (nlev == 2) ilmin=1 if (nlev == 2) ilmin=1
do ilev=ilmin,nlev 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 end do
write(iout_,*) write(iout_,*)
@ -656,7 +717,7 @@ contains
select type(prec) select type(prec)
type is (mld_zprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -686,7 +747,7 @@ contains
select type(prec) select type(prec)
type is (mld_zprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -718,7 +779,7 @@ contains
select type(prec) select type(prec)
type is (mld_zprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -747,7 +808,7 @@ contains
select type(prec) select type(prec)
type is (mld_zprec_type) 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 class default
info = psb_err_missing_override_method_ info = psb_err_missing_override_method_
call psb_errpush(info,name) call psb_errpush(info,name)

8
tests/fileread/Makefile
Unescape Escape View File

@ -15,23 +15,23 @@ EXEDIR=./runs
all: mld_sf_sample mld_df_sample mld_cf_sample mld_zf_sample all: mld_sf_sample mld_df_sample mld_cf_sample mld_zf_sample
mld_df_sample: $(DFSOBJS) mld_df_sample: $(DFSOBJS)
$(F90LINK) $(LINKOPT) $(DFSOBJS) -o mld_df_sample \ $(FLINK) $(LINKOPT) $(DFSOBJS) -o mld_df_sample \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_df_sample $(EXEDIR) /bin/mv mld_df_sample $(EXEDIR)
mld_sf_sample: $(SFSOBJS) mld_sf_sample: $(SFSOBJS)
$(F90LINK) $(LINKOPT) $(SFSOBJS) -o mld_sf_sample \ $(FLINK) $(LINKOPT) $(SFSOBJS) -o mld_sf_sample \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_sf_sample $(EXEDIR) /bin/mv mld_sf_sample $(EXEDIR)
mld_cf_sample: $(CFSOBJS) mld_cf_sample: $(CFSOBJS)
$(F90LINK) $(LINKOPT) $(CFSOBJS) -o mld_cf_sample \ $(FLINK) $(LINKOPT) $(CFSOBJS) -o mld_cf_sample \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_cf_sample $(EXEDIR) /bin/mv mld_cf_sample $(EXEDIR)
mld_zf_sample: $(ZFSOBJS) mld_zf_sample: $(ZFSOBJS)
$(F90LINK) $(LINKOPT) $(ZFSOBJS) -o mld_zf_sample \ $(FLINK) $(LINKOPT) $(ZFSOBJS) -o mld_zf_sample \
$(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv mld_zf_sample $(EXEDIR) /bin/mv mld_zf_sample $(EXEDIR)

2
tests/newslv/Makefile
Unescape Escape View File

@ -13,7 +13,7 @@ all: ppde3d
ppde3d: $(PD3DOBJS) ppde3d: $(PD3DOBJS)
$(F90LINK) $(PD3DOBJS) -o ppde3d $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) $(FLINK) $(PD3DOBJS) -o ppde3d $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
/bin/mv ppde3d $(EXEDIR) /bin/mv ppde3d $(EXEDIR)

8
tests/pdegen/Makefile
Unescape Escape View File

@ -11,19 +11,19 @@ EXEDIR=./runs
all: mld_s_pde3d mld_d_pde3d mld_s_pde2d mld_d_pde2d all: mld_s_pde3d mld_d_pde3d mld_s_pde2d mld_d_pde2d
mld_d_pde3d: mld_d_pde3d.o data_input.o 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) /bin/mv mld_d_pde3d $(EXEDIR)
mld_s_pde3d: mld_s_pde3d.o data_input.o 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) /bin/mv mld_s_pde3d $(EXEDIR)
mld_d_pde2d: mld_d_pde2d.o data_input.o 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) /bin/mv mld_d_pde2d $(EXEDIR)
mld_s_pde2d: mld_s_pde2d.o data_input.o 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) /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 mld_d_pde3d.o mld_s_pde3d.o mld_d_pde2d.o mld_s_pde2d.o: data_input.o

80
tests/pdegen/mld_d_pde2d.f90
Unescape Escape View File

@ -233,23 +233,23 @@ program mld_d_pde2d
! prepare the preconditioner. ! prepare the preconditioner.
! !
if (psb_toupper(prectype%prec) == 'ML') then if (psb_toupper(prectype%prec) == 'ML') then
call mld_precinit(prec,prectype%prec, info) call prec%init(prectype%prec, info)
if (prectype%csize>0)& 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)& 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)& 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) & if (prectype%athres >= dzero) &
& call mld_precset(prec,'aggr_thresh', prectype%athres, info) & call prec%set('aggr_thresh', prectype%athres, info)
call mld_precset(prec,'aggr_kind', prectype%aggrkind,info) call prec%set('aggr_kind', prectype%aggrkind,info)
call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info) call prec%set('aggr_alg', prectype%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info) call prec%set('aggr_ord', prectype%aggr_ord,info)
call mld_precset(prec,'aggr_filter', prectype%aggr_filter, info) call prec%set('aggr_filter', prectype%aggr_filter, info)
call psb_barrier(ictxt) call psb_barrier(ictxt)
t1 = psb_wtime() 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 if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='psb_precbld' ch_err='psb_precbld'
@ -259,27 +259,27 @@ program mld_d_pde2d
thier = psb_wtime()-t1 thier = psb_wtime()-t1
call mld_precset(prec,'smoother_type', prectype%smther, info) call prec%set('smoother_type', prectype%smther, info)
call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info) call prec%set('smoother_sweeps', prectype%jsweeps, info)
call mld_precset(prec,'sub_ovr', prectype%novr, info) call prec%set('sub_ovr', prectype%novr, info)
call mld_precset(prec,'sub_restr', prectype%restr, info) call prec%set('sub_restr', prectype%restr, info)
call mld_precset(prec,'sub_prol', prectype%prol, info) call prec%set('sub_prol', prectype%prol, info)
call mld_precset(prec,'sub_solve', prectype%solve, info) call prec%set('sub_solve', prectype%solve, info)
call mld_precset(prec,'sub_fillin', prectype%fill1, info) call prec%set('sub_fillin', prectype%fill1, info)
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call prec%set('solver_sweeps', prectype%svsweeps, info)
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call prec%set('sub_iluthrs', prectype%thr1, info)
call mld_precset(prec,'ml_type', prectype%mltype, info) call prec%set('ml_type', prectype%mltype, info)
call mld_precset(prec,'smoother_pos', prectype%smthpos, info) call prec%set('smoother_pos', prectype%smthpos, info)
call mld_precset(prec,'coarse_solve', prectype%csolve, info) call prec%set('coarse_solve', prectype%csolve, info)
call mld_precset(prec,'coarse_subsolve', prectype%csbsolve,info) call prec%set('coarse_subsolve', prectype%csbsolve,info)
call mld_precset(prec,'coarse_mat', prectype%cmat, info) call prec%set('coarse_mat', prectype%cmat, info)
call mld_precset(prec,'coarse_fillin', prectype%cfill, info) call prec%set('coarse_fillin', prectype%cfill, info)
call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info) call prec%set('coarse_iluthrs', prectype%cthres, info)
call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info) call prec%set('coarse_sweeps', prectype%cjswp, info)
call psb_barrier(ictxt) call psb_barrier(ictxt)
t1 = psb_wtime() 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 if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='psb_precbld' ch_err='psb_precbld'
@ -290,19 +290,19 @@ program mld_d_pde2d
else else
nlv = 1 nlv = 1
call mld_precinit(prec,prectype%prec, info) call prec%init(prectype%prec, info)
call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info) call prec%set('smoother_sweeps', prectype%jsweeps, info)
call mld_precset(prec,'sub_ovr', prectype%novr, info) call prec%set('sub_ovr', prectype%novr, info)
call mld_precset(prec,'sub_restr', prectype%restr, info) call prec%set('sub_restr', prectype%restr, info)
call mld_precset(prec,'sub_prol', prectype%prol, info) call prec%set('sub_prol', prectype%prol, info)
call mld_precset(prec,'sub_solve', prectype%solve, info) call prec%set('sub_solve', prectype%solve, info)
call mld_precset(prec,'sub_fillin', prectype%fill1, info) call prec%set('sub_fillin', prectype%fill1, info)
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call prec%set('solver_sweeps', prectype%svsweeps, info)
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call prec%set('sub_iluthrs', prectype%thr1, info)
call psb_barrier(ictxt) call psb_barrier(ictxt)
thier = dzero thier = dzero
t1 = psb_wtime() t1 = psb_wtime()
call mld_precbld(a,desc_a,prec,info) call prec%build(a,desc_a,info)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='psb_precbld' ch_err='psb_precbld'
@ -319,7 +319,7 @@ program mld_d_pde2d
if (iam == psb_root_) & if (iam == psb_root_) &
& write(psb_out_unit,'("Preconditioner time : ",es12.5)') tprec+thier & 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_) & if (iam == psb_root_) &
& write(psb_out_unit,'(" ")') & write(psb_out_unit,'(" ")')
@ -378,7 +378,7 @@ program mld_d_pde2d
call psb_gefree(b,desc_a,info) call psb_gefree(b,desc_a,info)
call psb_gefree(x,desc_a,info) call psb_gefree(x,desc_a,info)
call psb_spfree(a,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) call psb_cdfree(desc_a,info)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

81
tests/pdegen/mld_d_pde3d.f90
Unescape Escape View File

@ -245,24 +245,23 @@ program mld_d_pde3d
! prepare the preconditioner. ! prepare the preconditioner.
! !
if (psb_toupper(prectype%prec) == 'ML') then if (psb_toupper(prectype%prec) == 'ML') then
call mld_precinit(prec,prectype%prec, info) call prec%init(prectype%prec, info)
if (prectype%csize>0)& 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)& 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)& 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) & if (prectype%athres >= dzero) &
& call mld_precset(prec,'aggr_thresh', prectype%athres, info) & call prec%set('aggr_thresh', prectype%athres, info)
call mld_precset(prec,'aggr_kind', prectype%aggrkind,info) call prec%set('aggr_kind', prectype%aggrkind,info)
call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info) call prec%set('aggr_alg', prectype%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info) call prec%set('aggr_ord', prectype%aggr_ord,info)
call mld_precset(prec,'aggr_filter', prectype%aggr_filter, info) call prec%set('aggr_filter', prectype%aggr_filter, info)
call psb_barrier(ictxt) call psb_barrier(ictxt)
t1 = psb_wtime() 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 if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='psb_precbld' ch_err='psb_precbld'
@ -272,27 +271,27 @@ program mld_d_pde3d
thier = psb_wtime()-t1 thier = psb_wtime()-t1
call mld_precset(prec,'smoother_type', prectype%smther, info) call prec%set('smoother_type', prectype%smther, info)
call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info) call prec%set('smoother_sweeps', prectype%jsweeps, info)
call mld_precset(prec,'sub_ovr', prectype%novr, info) call prec%set('sub_ovr', prectype%novr, info)
call mld_precset(prec,'sub_restr', prectype%restr, info) call prec%set('sub_restr', prectype%restr, info)
call mld_precset(prec,'sub_prol', prectype%prol, info) call prec%set('sub_prol', prectype%prol, info)
call mld_precset(prec,'sub_solve', prectype%solve, info) call prec%set('sub_solve', prectype%solve, info)
call mld_precset(prec,'sub_fillin', prectype%fill1, info) call prec%set('sub_fillin', prectype%fill1, info)
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call prec%set('solver_sweeps', prectype%svsweeps, info)
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call prec%set('sub_iluthrs', prectype%thr1, info)
call mld_precset(prec,'ml_type', prectype%mltype, info) call prec%set('ml_type', prectype%mltype, info)
call mld_precset(prec,'smoother_pos', prectype%smthpos, info) call prec%set('smoother_pos', prectype%smthpos, info)
call mld_precset(prec,'coarse_solve', prectype%csolve, info) call prec%set('coarse_solve', prectype%csolve, info)
call mld_precset(prec,'coarse_subsolve', prectype%csbsolve,info) call prec%set('coarse_subsolve', prectype%csbsolve,info)
call mld_precset(prec,'coarse_mat', prectype%cmat, info) call prec%set('coarse_mat', prectype%cmat, info)
call mld_precset(prec,'coarse_fillin', prectype%cfill, info) call prec%set('coarse_fillin', prectype%cfill, info)
call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info) call prec%set('coarse_iluthrs', prectype%cthres, info)
call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info) call prec%set('coarse_sweeps', prectype%cjswp, info)
call psb_barrier(ictxt) call psb_barrier(ictxt)
t1 = psb_wtime() 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 if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='psb_precbld' ch_err='psb_precbld'
@ -303,19 +302,19 @@ program mld_d_pde3d
else else
nlv = 1 nlv = 1
call mld_precinit(prec,prectype%prec, info) call prec%init(prectype%prec, info)
call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info) call prec%set('smoother_sweeps', prectype%jsweeps, info)
call mld_precset(prec,'sub_ovr', prectype%novr, info) call prec%set('sub_ovr', prectype%novr, info)
call mld_precset(prec,'sub_restr', prectype%restr, info) call prec%set('sub_restr', prectype%restr, info)
call mld_precset(prec,'sub_prol', prectype%prol, info) call prec%set('sub_prol', prectype%prol, info)
call mld_precset(prec,'sub_solve', prectype%solve, info) call prec%set('sub_solve', prectype%solve, info)
call mld_precset(prec,'sub_fillin', prectype%fill1, info) call prec%set('sub_fillin', prectype%fill1, info)
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call prec%set('solver_sweeps', prectype%svsweeps, info)
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call prec%set('sub_iluthrs', prectype%thr1, info)
call psb_barrier(ictxt) call psb_barrier(ictxt)
thier = dzero thier = dzero
t1 = psb_wtime() t1 = psb_wtime()
call mld_precbld(a,desc_a,prec,info) call prec%build(a,desc_a,info)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='psb_precbld' ch_err='psb_precbld'
@ -332,7 +331,7 @@ program mld_d_pde3d
if (iam == psb_root_) & if (iam == psb_root_) &
& write(psb_out_unit,'("Preconditioner time : ",es12.5)') tprec+thier & 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_) & if (iam == psb_root_) &
& write(psb_out_unit,'(" ")') & write(psb_out_unit,'(" ")')
@ -391,7 +390,7 @@ program mld_d_pde3d
call psb_gefree(b,desc_a,info) call psb_gefree(b,desc_a,info)
call psb_gefree(x,desc_a,info) call psb_gefree(x,desc_a,info)
call psb_spfree(a,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) call psb_cdfree(desc_a,info)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

2
tests/pdegen/runs/mld_pde3d.inp
Unescape Escape View File

@ -18,7 +18,7 @@ SMOOTHED ! Type of aggregation: SMOOTHED, UNSMOOTHED, MINENER
DEC ! Type of aggregation: DEC SYMDEC DEC ! Type of aggregation: DEC SYMDEC
NATURAL ! Ordering of aggregation: NATURAL DEGREE NATURAL ! Ordering of aggregation: NATURAL DEGREE
FILTER ! Filtering aggregation: FILTER NOFILTER 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) TWOSIDE ! Side of correction: PRE POST TWOSIDE (ignored for ADD)
4 ! Smoother sweeps 4 ! Smoother sweeps
BJAC ! Smoother type JACOBI BJAC AS; ignored for non-ML BJAC ! Smoother type JACOBI BJAC AS; ignored for non-ML

Write Preview
Loading…
Cancel
Save