Added rkr solver

.gitignore

@@ -12,9 +12,9 @@ config.log
 config.status
 
 # generated folder
-/include/
-/modules/
-/docs/src/tmp
+include/
+modules/
+docs/src/tmp
 autom4te.cache
 
 # the executable from tests

Changelog

@@ -1,6 +1,5 @@
 Changelog. A lot less detailed than usual, at least for past
 	history.
-2022/05/20: Restart ChangeLog. Updated to new name AMG4PSBLAS, now using PSB3.8	
 2018/10/28: Fix interface to MUMPS and configry machinery. Require PSB 3.6.
 2018/10/10: ICTXT argument in prec%init().	
 2018/07/30: Fixes for Intel compilers. BootCMatch interface in examples. 	

LICENSE

@@ -1,10 +1,10 @@
   
    
-                             AMG4PSBLAS version 1.1
+                             AMG4PSBLAS version 1.0
     Algebraic Multigrid Package
-               based on PSBLAS (Parallel Sparse BLAS version 3.8)
+               based on PSBLAS (Parallel Sparse BLAS version 3.7)
     
-    (C) Copyright 2022
+    (C) Copyright 2020 
   
         Salvatore Filippone  
         Pasqua D'Ambra   

Make.inc.in

@@ -2,10 +2,10 @@
 .mod=@MODEXT@
 .fh=.fh
 .SUFFIXES: 
-.SUFFIXES: .f90 .F90 .f .F .c .cpp .o
+.SUFFIXES: .f90 .F90 .f .F .c .o
 ##########################################################
 #                                                        #
-#  Note: directories external to the AMG4PSBLAS subtree  #
+#  Note: directories external to the MLD2P4 subtree      #
 #  must be specified here with absolute pathnames        #
 #                                                        #
 ##########################################################
@@ -16,7 +16,6 @@ PSBLAS_LIBDIR=@PSBLAS_LIBDIR@
 @PSBLAS_INSTALL_MAKEINC@
 PSBLAS_INCLUDES=@PSBLAS_INCLUDES@
 PSBLAS_LIBS=@PSBLAS_LIBS@	
-PSBBASEMODNAME=psb_base_mod
 
 
 
@@ -70,16 +69,15 @@ EXTRALIBS=@EXTRA_LIBS@
 
 
 #
-AMGCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
-CDEFINES=$(AMGCDEFINES)
-AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
-FDEFINES=$(AMGFDEFINES)
+MLDCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
+MLDFDEFINES=@FDEFINES@ $(PSBFDEFINES)
 
-CXXDEFINES=@AMGCXXDEFINES@ $(PSBCXXDEFINES)
+CDEFINES=$(MLDCDEFINES)
+FDEFINES=$(MLDFDEFINES)
 
 @COMPILERULES@
 
 
-AMGLDLIBS=$(MUMPSLIBS) $(SLULIBS) $(SLUDISTLIBS) $(UMFLIBS) $(EXTRALIBS) $(PSBLDLIBS) -lstdc++
-LDLIBS=$(AMGLDLIBS)
+MLDLDLIBS=$(MUMPSLIBS) $(SLULIBS) $(SLUDISTLIBS) $(UMFLIBS) $(EXTRALIBS) $(PSBLDLIBS)
+LDLIBS=$(MLDLDLIBS)
 

Make_n.inc.in

@@ -1,120 +0,0 @@
-##########################################################
-.mod=@MODEXT@
-.fh=.fh
-.SUFFIXES: 
-.SUFFIXES: .f90 .F90 .f .F .c .cpp .o
-# The following ones are the variables used by the PSBLAS make scripts.
-
-FC=@FC@
-CC=@CC@
-CXX=@CXX@
-FCOPT=@FCOPT@
-CCOPT=@CCOPT@
-CXXOPT=@CXXOPT@
-FMFLAG=@FMFLAG@
-FIFLAG=@FIFLAG@
-EXTRA_OPT=@EXTRA_OPT@
-
-# These three should be always set!
-MPFC=@MPIFC@
-MPCC=@MPICC@
-MPCXX=@MPICXX@
-
-FLINK=@FLINK@
-
-LIBS=@LIBS@
-
-# BLAS, BLACS and METIS libraries.
-BLAS=@BLAS_LIBS@
-METIS_LIB=@METIS_LIBS@
-LAPACK=@LAPACK_LIBS@
-
-PSBFDEFINES=@FDEFINES@
-PSBCDEFINES=@CDEFINES@
-PSBCXXDEFINES=@CDEFINES@
-AR=@AR@
-RANLIB=@RANLIB@
-
-##########################################################
-#                                                        #
-#  Note: directories external to the AMG4PSBLAS subtree  #
-#  must be specified here with absolute pathnames        #
-#                                                        #
-##########################################################
-PSBLASDIR=@PSBLAS_DIR@
-PSBLAS_INCDIR=@PSBLAS_INCDIR@
-PSBLAS_MODDIR=@PSBLAS_MODDIR@
-PSBLAS_LIBDIR=@PSBLAS_LIBDIR@
-PSBLAS_INCLUDES=@PSBLAS_INCLUDES@
-PSBLAS_LIBS=@PSBLAS_LIBS@	
-PSBBASEMODNAME=psb_base_mod
-PSBPRECMODNAME=psb_prec_mod
-PSBMETHDMODNAME=psb_krylov_mod
-PSBUTILMODNAME=psb_util_mod
-
-
-
-
-INSTALL=@INSTALL@
-INSTALL_DATA=@INSTALL_DATA@
-INSTALL_DIR=@INSTALL_DIR@
-INSTALL_LIBDIR=@INSTALL_LIBDIR@
-INSTALL_INCLUDEDIR=@INSTALL_INCLUDEDIR@
-INSTALL_MODULESDIR=@INSTALL_MODULESDIR@
-INSTALL_DOCSDIR=@INSTALL_DOCSDIR@
-INSTALL_SAMPLESDIR=@INSTALL_SAMPLESDIR@
-
-
-##########################################################
-#                                                        #
-#  Additional defines and libraries for multilevel       #
-#  Note that these libraries should be compatible        #
-#  (compiled with) the compilers specified in the        #
-#  PSBLAS main Make.inc                                  #
-#                                                        #
-#  Examples:                                             #
-#  MUMPSLIBS=-ldmumps -lmumps_common                     #
-#             -lpord -L/path/to/MUMPS/lib                #
-#  MUMPSFLAGS=-DHave_MUMPS_ -I/path/to/MUMPS/include     #
-#                                                        #
-#  UMFLIBS=-lumfpack -lamd -L/path/to/UMFPACK            #
-#  UMFFLAGS=-DHave_UMF_ -I/path/to/UMFPACK               #
-#                                                        #
-#  SLULIBS=-lslu   -L/path/to/SuperLU                    #
-#  SLUFLAGS=-DHave_SLU_ -I/path/to/SuperLU               #
-#                                                        #
-#  SLUDISTLIBS=-lslud -L/path/to/SuperLUDist             #
-#  SLUDISTFLAGS=-DHave_SLUDist_ -I/path/to/SuperLUDist   #
-#                                                        #
-##########################################################
-
-MUMPSLIBS=@MUMPS_LIBS@
-MUMPSFLAGS=@MUMPS_FLAGS@
-
-SLULIBS=@SLU_LIBS@
-SLUFLAGS=@SLU_FLAGS@
-
-SLUDISTLIBS=@SLUDIST_LIBS@
-SLUDISTFLAGS=@SLUDIST_FLAGS@
-
-UMFLIBS=@UMF_LIBS@
-UMFFLAGS=@UMF_FLAGS@
-
-EXTRALIBS=@EXTRA_LIBS@
-
-
-
-@COMPILERULES@
-
-#
-AMGCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
-CDEFINES=$(AMGCDEFINES)
-AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
-FDEFINES=$(AMGFDEFINES)
-
-CXXDEFINES=@AMGCXXDEFINES@ $(PSBCXXDEFINES)
-
-AMGLDLIBS=$(MUMPSLIBS) $(SLULIBS) $(SLUDISTLIBS) $(UMFLIBS) $(EXTRALIBS) $(PSBLDLIBS) -lstdc++
-LDLIBS=$(AMGLDLIBS)
-
-

Makefile

@@ -1,13 +1,10 @@
 include Make.inc
 
 
-all:  objs lib
+all:  library 
 
-objs: amgp cbnd
-
-lib: libdir objs
-	cd amgprec && $(MAKE) lib
-	cd cbind && $(MAKE)  lib
+library: libdir amgp
+#cbnd
 
 libdir:
 	(if test ! -d lib ; then mkdir lib; fi)
@@ -17,11 +14,10 @@ libdir:
         
 
 amgp:
-	cd amgprec && $(MAKE) objs
+	$(MAKE) -C amgprec all
 cbnd: amgp
-	cd cbind && $(MAKE)  objs
-
-install: lib
+	$(MAKE) -C cbind all
+install: all
 	mkdir -p $(INSTALL_LIBDIR) &&\
 	   $(INSTALL_DATA) lib/*.a  $(INSTALL_LIBDIR)
 	mkdir -p  $(INSTALL_INCLUDEDIR) &&\
@@ -37,22 +33,22 @@ install: lib
 	mkdir -p  $(INSTALL_SAMPLESDIR) && \
 		 mkdir -p  $(INSTALL_SAMPLESDIR)/simple &&\
 	 	 mkdir -p  $(INSTALL_SAMPLESDIR)/advanced && \
-		(cd samples/simple; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/simple ) && \
-		(cd samples/advanced; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/advanced )
+		(cd examples; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/simple ) && \
+		(cd tests; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/advanced )
 cleanlib:
 	(cd lib; /bin/rm -f *.a *$(.mod) *$(.fh))
 	(cd include; /bin/rm -f *.a *$(.mod) *$(.fh))
 	(cd modules; /bin/rm -f *.a *$(.mod) *$(.fh))
 
 veryclean: cleanlib
-	(cd amgprec && $(MAKE) veryclean)
-	(cd samples/simple/fileread && $(MAKE) clean)
-	(cd samples/simple/pdegen && $(MAKE) clean)
-	(cd samples/advanced/fileread && $(MAKE) clean)
-	(cd samples/advanced/pdegen && $(MAKE) clean)
+	(cd amgprec; make veryclean)
+	(cd examples/fileread; make clean)
+	(cd examples/pdegen; make clean)
+	(cd tests/fileread; make clean)
+	(cd tests/pdegen; make clean)
 
 check: all
-	make check -C samples/advanced/pdegen
+	make check -C tests/pdegen
 
 clean:
-	(cd amgprec && $(MAKE) clean)
+	(cd amgprec; make clean)

README.md

@@ -1,5 +1,6 @@
+
                          AMG4PSBLAS  
- Algebraic Multigrid Package  based on PSBLAS (Parallel Sparse BLAS version 3.8)
+ Algebraic Multigrid Package  based on PSBLAS (Parallel Sparse BLAS version 3.7)
     
 Salvatore Filippone    (University of Rome Tor Vergata and IAC-CNR)
 Pasqua D'Ambra         (IAC-CNR, Naples, IT)

amgprec/Makefile

@@ -9,46 +9,48 @@ FINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(INCDIR) $(PSBLAS_INCLUDES)
 
 DMODOBJS=amg_d_prec_type.o \
 	amg_d_inner_mod.o amg_d_ilu_solver.o amg_d_diag_solver.o amg_d_jac_smoother.o amg_d_as_smoother.o \
-        amg_d_poly_smoother.o amg_d_poly_coeff_mod.o\
 	amg_d_umf_solver.o amg_d_slu_solver.o amg_d_sludist_solver.o amg_d_id_solver.o\
 	amg_d_base_solver_mod.o amg_d_base_smoother_mod.o amg_d_onelev_mod.o \
-	amg_d_gs_solver.o amg_d_mumps_solver.o amg_d_jac_solver.o \
+	amg_d_gs_solver.o amg_d_mumps_solver.o \
 	amg_d_base_aggregator_mod.o \
 	amg_d_dec_aggregator_mod.o amg_d_symdec_aggregator_mod.o \
 	amg_d_ainv_solver.o amg_d_base_ainv_mod.o \
-	amg_d_invk_solver.o amg_d_invt_solver.o amg_d_krm_solver.o \
-	amg_d_matchboxp_mod.o amg_d_parmatch_aggregator_mod.o
+	amg_d_invk_solver.o amg_d_invt_solver.o \
+	amg_d_rkr_solver.o
+#amg_d_bcmatch_aggregator_mod.o
 
 SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \
 	amg_s_inner_mod.o amg_s_ilu_solver.o amg_s_diag_solver.o amg_s_jac_smoother.o amg_s_as_smoother.o \
-	amg_s_poly_smoother.o amg_s_slu_solver.o amg_s_id_solver.o\
+	amg_s_slu_solver.o amg_s_id_solver.o\
 	amg_s_base_solver_mod.o amg_s_base_smoother_mod.o amg_s_onelev_mod.o  \
-	amg_s_gs_solver.o amg_s_mumps_solver.o  amg_s_jac_solver.o \
+	amg_s_gs_solver.o amg_s_mumps_solver.o \
 	amg_s_base_aggregator_mod.o  \
 	amg_s_dec_aggregator_mod.o amg_s_symdec_aggregator_mod.o \
 	amg_s_ainv_solver.o amg_s_base_ainv_mod.o \
-	amg_s_invk_solver.o amg_s_invt_solver.o amg_s_krm_solver.o \
-	amg_s_matchboxp_mod.o amg_s_parmatch_aggregator_mod.o
+	amg_s_invk_solver.o amg_s_invt_solver.o \
+	amg_s_rkr_solver.o
 
 ZMODOBJS=amg_z_prec_type.o amg_z_ilu_fact_mod.o \
 	amg_z_inner_mod.o amg_z_ilu_solver.o amg_z_diag_solver.o amg_z_jac_smoother.o amg_z_as_smoother.o \
 	amg_z_umf_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o amg_z_id_solver.o\
 	amg_z_base_solver_mod.o amg_z_base_smoother_mod.o amg_z_onelev_mod.o \
-	amg_z_gs_solver.o amg_z_mumps_solver.o  amg_z_jac_solver.o \
+	amg_z_gs_solver.o amg_z_mumps_solver.o \
 	amg_z_base_aggregator_mod.o  \
 	amg_z_dec_aggregator_mod.o amg_z_symdec_aggregator_mod.o \
 	amg_z_ainv_solver.o amg_z_base_ainv_mod.o \
-	amg_z_invk_solver.o amg_z_invt_solver.o amg_z_krm_solver.o
+	amg_z_invk_solver.o amg_z_invt_solver.o \
+	amg_z_rkr_solver.o
 
 CMODOBJS=amg_c_prec_type.o amg_c_ilu_fact_mod.o \
 	amg_c_inner_mod.o amg_c_ilu_solver.o amg_c_diag_solver.o amg_c_jac_smoother.o amg_c_as_smoother.o \
 	amg_c_slu_solver.o amg_c_id_solver.o\
 	amg_c_base_solver_mod.o amg_c_base_smoother_mod.o amg_c_onelev_mod.o  \
-	amg_c_gs_solver.o amg_c_mumps_solver.o  amg_c_jac_solver.o \
+	amg_c_gs_solver.o amg_c_mumps_solver.o \
 	amg_c_base_aggregator_mod.o  \
 	amg_c_dec_aggregator_mod.o amg_c_symdec_aggregator_mod.o \
 	amg_c_ainv_solver.o amg_c_base_ainv_mod.o \
-	amg_c_invk_solver.o amg_c_invt_solver.o amg_c_krm_solver.o
+	amg_c_invk_solver.o amg_c_invt_solver.o \
+	amg_c_rkr_solver.o
 
 
 
@@ -63,37 +65,25 @@ OBJS=$(MODOBJS)
 LOCAL_MODS=$(MODOBJS:.o=$(.mod))
 LIBNAME=libamg_prec.a
 
-all: objs impld
+all: lib impld
 
-objs: $(OBJS)
-	/bin/cp -p amg_const.h $(INCDIR)
-	/bin/cp -p *$(.mod) $(MODDIR)
-
-impld: objs
-	cd impl && $(MAKE) 
+impld: $(OBJS)
+	$(MAKE) -C impl
 
 lib: $(OBJS) impld
-	cd impl && $(MAKE) lib
 	$(AR) $(HERE)/$(LIBNAME) $(OBJS)
 	$(RANLIB) $(HERE)/$(LIBNAME)
 	/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
+	/bin/cp -p amg_const.h $(INCDIR)
+	/bin/cp -p *$(.mod) $(MODDIR)
 
 
-$(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
+$(MODOBJS): $(PSBLAS_MODDIR)/$(BASEMODNAME)$(.mod)
 
 amg_base_prec_type.o: amg_const.h
 amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o	: amg_base_prec_type.o
 amg_prec_type.o: amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o
 amg_prec_mod.o: amg_prec_type.o amg_s_prec_mod.o amg_d_prec_mod.o amg_c_prec_mod.o amg_z_prec_mod.o
-amg_s_krm_solver.o: amg_s_prec_type.o  amg_s_base_solver_mod.o
-amg_d_krm_solver.o: amg_d_prec_type.o  amg_d_base_solver_mod.o
-amg_c_krm_solver.o: amg_c_prec_type.o  amg_c_base_solver_mod.o
-amg_z_krm_solver.o: amg_z_prec_type.o  amg_z_base_solver_mod.o
-
-amg_s_prec_mod.o: amg_s_krm_solver.o
-amg_d_prec_mod.o: amg_d_krm_solver.o
-amg_c_prec_mod.o: amg_c_krm_solver.o
-amg_z_prec_mod.o: amg_z_krm_solver.o
 
 $(SINNEROBJS) $(SOUTEROBJS): $(SMODOBJS)
 $(DINNEROBJS) $(DOUTEROBJS): $(DMODOBJS)
@@ -116,27 +106,25 @@ amg_d_prec_type.o: amg_d_onelev_mod.o
 amg_c_prec_type.o: amg_c_onelev_mod.o
 amg_z_prec_type.o: amg_z_onelev_mod.o
 
-amg_s_onelev_mod.o: amg_s_base_smoother_mod.o amg_s_dec_aggregator_mod.o amg_s_parmatch_aggregator_mod.o 
-amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o amg_d_parmatch_aggregator_mod.o 
+amg_s_onelev_mod.o: amg_s_base_smoother_mod.o amg_s_dec_aggregator_mod.o
+amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o
 amg_c_onelev_mod.o: amg_c_base_smoother_mod.o amg_c_dec_aggregator_mod.o
 amg_z_onelev_mod.o: amg_z_base_smoother_mod.o amg_z_dec_aggregator_mod.o
 
 amg_s_base_aggregator_mod.o: amg_base_prec_type.o
-amg_s_parmatch_aggregator_mod.o amg_s_dec_aggregator_mod.o: amg_s_base_aggregator_mod.o
+amg_s_dec_aggregator_mod.o: amg_s_base_aggregator_mod.o
 amg_s_hybrid_aggregator_mod.o amg_s_symdec_aggregator_mod.o: amg_s_dec_aggregator_mod.o
-amg_s_parmatch_aggregator_mod.o: amg_s_matchboxp_mod.o 
 
 amg_d_base_aggregator_mod.o: amg_base_prec_type.o
-amg_d_parmatch_aggregator_mod.o amg_d_dec_aggregator_mod.o: amg_d_base_aggregator_mod.o
+amg_d_dec_aggregator_mod.o: amg_d_base_aggregator_mod.o
 amg_d_hybrid_aggregator_mod.o amg_d_symdec_aggregator_mod.o: amg_d_dec_aggregator_mod.o
-amg_d_parmatch_aggregator_mod.o: amg_d_matchboxp_mod.o 
 
 amg_c_base_aggregator_mod.o: amg_base_prec_type.o
-amg_c_parmatch_aggregator_mod.o amg_c_dec_aggregator_mod.o: amg_c_base_aggregator_mod.o
+amg_c_dec_aggregator_mod.o: amg_c_base_aggregator_mod.o
 amg_c_hybrid_aggregator_mod.o amg_c_symdec_aggregator_mod.o: amg_c_dec_aggregator_mod.o
 
 amg_z_base_aggregator_mod.o: amg_base_prec_type.o
-amg_z_parmatch_aggregator_mod.o amg_z_dec_aggregator_mod.o: amg_z_base_aggregator_mod.o
+amg_z_dec_aggregator_mod.o: amg_z_base_aggregator_mod.o
 amg_z_hybrid_aggregator_mod.o amg_z_symdec_aggregator_mod.o: amg_z_dec_aggregator_mod.o
 
 amg_s_base_smoother_mod.o: amg_s_base_solver_mod.o
@@ -153,10 +141,15 @@ amg_c_base_ainv_mod.o: amg_c_base_solver_mod.o amg_base_ainv_mod.o
 amg_d_base_ainv_mod.o: amg_d_base_solver_mod.o amg_base_ainv_mod.o
 amg_z_base_ainv_mod.o: amg_z_base_solver_mod.o amg_base_ainv_mod.o
 
+amg_d_rkr_solver.o: amg_d_base_solver_mod.o amg_d_prec_type.o
+amg_s_rkr_solver.o: amg_s_base_solver_mod.o amg_s_prec_type.o
+amg_c_rkr_solver.o: amg_c_base_solver_mod.o amg_c_prec_type.o
+amg_z_rkr_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.o
+
 amg_s_base_solver_mod.o amg_d_base_solver_mod.o amg_c_base_solver_mod.o amg_z_base_solver_mod.o: amg_base_prec_type.o
 
 amg_d_mumps_solver.o amg_d_gs_solver.o amg_d_id_solver.o amg_d_sludist_solver.o amg_d_slu_solver.o \
-amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o amg_d_jac_solver.o: amg_d_base_solver_mod.o  amg_d_prec_type.o
+amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o: amg_d_base_solver_mod.o  amg_d_prec_type.o
 
 #amg_d_ilu_fact_mod.o: amg_base_prec_type.o  amg_d_base_solver_mod.o
 #amg_d_ilu_solver.o amg_d_iluk_fact.o: amg_d_ilu_fact_mod.o
@@ -165,11 +158,9 @@ amg_d_jac_smoother.o: amg_d_diag_solver.o
 amg_dprecinit.o amg_dprecset.o: amg_d_diag_solver.o amg_d_ilu_solver.o \
 		amg_d_umf_solver.o amg_d_as_smoother.o amg_d_jac_smoother.o \
 	        amg_d_id_solver.o amg_d_slu_solver.o amg_d_sludist_solver.o
-amg_d_poly_smoother.o: amg_d_base_smoother_mod.o amg_d_poly_coeff_mod.o
-amg_s_poly_smoother.o: amg_s_base_smoother_mod.o amg_d_poly_coeff_mod.o	
 
 amg_s_mumps_solver.o amg_s_gs_solver.o amg_s_id_solver.o amg_s_slu_solver.o \
-amg_s_diag_solver.o amg_s_ilu_solver.o amg_s_jac_solver.o: amg_s_base_solver_mod.o  amg_s_prec_type.o
+amg_s_diag_solver.o amg_s_ilu_solver.o: amg_s_base_solver_mod.o  amg_s_prec_type.o
 amg_s_ilu_fact_mod.o: amg_base_prec_type.o  amg_s_base_solver_mod.o
 amg_s_ilu_solver.o amg_s_iluk_fact.o: amg_s_ilu_fact_mod.o
 amg_s_as_smoother.o amg_s_jac_smoother.o: amg_s_base_smoother_mod.o
@@ -179,7 +170,7 @@ amg_sprecinit.o amg_sprecset.o: amg_s_diag_solver.o amg_s_ilu_solver.o \
 	        amg_s_id_solver.o amg_s_slu_solver.o
 
 amg_z_mumps_solver.o amg_z_gs_solver.o amg_z_id_solver.o amg_z_sludist_solver.o amg_z_slu_solver.o \
-amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o amg_z_jac_solver.o: amg_z_base_solver_mod.o  amg_z_prec_type.o
+amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o: amg_z_base_solver_mod.o  amg_z_prec_type.o
 amg_z_ilu_fact_mod.o: amg_base_prec_type.o  amg_z_base_solver_mod.o
 amg_z_ilu_solver.o amg_z_iluk_fact.o: amg_z_ilu_fact_mod.o
 amg_z_as_smoother.o amg_z_jac_smoother.o: amg_z_base_smoother_mod.o
@@ -189,7 +180,7 @@ amg_zprecinit.o amg_zprecset.o: amg_z_diag_solver.o amg_z_ilu_solver.o \
 	        amg_z_id_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o
 
 amg_c_mumps_solver.o amg_c_gs_solver.o amg_c_id_solver.o amg_c_sludist_solver.o amg_c_slu_solver.o \
-amg_c_diag_solver.o amg_c_ilu_solver.o amg_c_jac_solver.o: amg_c_base_solver_mod.o  amg_c_prec_type.o
+amg_c_diag_solver.o amg_c_ilu_solver.o: amg_c_base_solver_mod.o  amg_c_prec_type.o
 amg_c_ilu_fact_mod.o: amg_base_prec_type.o  amg_c_base_solver_mod.o
 amg_c_ilu_solver.o amg_c_iluk_fact.o: amg_c_ilu_fact_mod.o
 amg_c_as_smoother.o amg_c_jac_smoother.o: amg_c_base_smoother_mod.o
@@ -224,4 +215,4 @@ clean: implclean
 	/bin/rm -f $(OBJS) $(LOCAL_MODS) *$(.mod)
 
 implclean:
-	cd impl && $(MAKE) clean
+	$(MAKE) -C impl clean

amgprec/amg_c_ainv_solver.F90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -58,13 +55,13 @@ module amg_c_ainv_solver
     procedure, pass(sv) :: check   => amg_c_ainv_solver_check
     procedure, pass(sv) :: build   => amg_c_ainv_solver_bld
     procedure, pass(sv) :: clone   => amg_c_ainv_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_c_ainv_solver_clone_settings
     procedure, pass(sv) :: cseti   => amg_c_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_c_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_c_ainv_solver_csetr
-!!$    procedure, pass(sv) :: seti    => amg_c_ainv_solver_seti
-!!$    procedure, pass(sv) :: setc    => amg_c_ainv_solver_setc
-!!$    procedure, pass(sv) :: setr    => amg_c_ainv_solver_setr
+    procedure, pass(sv) :: seti    => amg_c_ainv_solver_seti
+    procedure, pass(sv) :: setc    => amg_c_ainv_solver_setc
+    procedure, pass(sv) :: setr    => amg_c_ainv_solver_setr
+    generic, public :: set => seti, setr, setc
     procedure, pass(sv) :: descr   => amg_c_ainv_solver_descr
     procedure, pass(sv) :: default => c_ainv_solver_default
     procedure, nopass   :: stringval  => c_ainv_stringval
@@ -86,16 +83,6 @@ module amg_c_ainv_solver
     end subroutine amg_c_ainv_solver_clone
   end interface
 
-  interface
-    subroutine amg_c_ainv_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
-       & amg_c_base_solver_type, psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
-      Implicit None
-      class(amg_c_ainv_solver_type), intent(inout)              :: sv
-      class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_c_ainv_solver_clone_settings
-  end interface
 
   interface
     subroutine amg_c_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
@@ -172,44 +159,44 @@ module amg_c_ainv_solver
     end subroutine amg_c_ainv_solver_csetr
   end interface
 
-!!$  interface
-!!$    subroutine amg_c_ainv_solver_setc(sv,what,val,info)
-!!$      import :: amg_c_ainv_solver_type, psb_ipk_
-!!$      Implicit none
-!!$      ! Arguments
-!!$      class(amg_c_ainv_solver_type), intent(inout) :: sv
-!!$      integer(psb_ipk_), intent(in)                :: what
-!!$      character(len=*), intent(in)                 :: val
-!!$      integer(psb_ipk_), intent(out)               :: info
-!!$    end subroutine amg_c_ainv_solver_setc
-!!$  end interface
-!!$
-!!$  interface
-!!$    subroutine amg_c_ainv_solver_seti(sv,what,val,info)
-!!$      import :: amg_c_ainv_solver_type, psb_ipk_
-!!$      Implicit none
-!!$      ! Arguments
-!!$      class(amg_c_ainv_solver_type), intent(inout) :: sv
-!!$      integer(psb_ipk_), intent(in)                :: what
-!!$      integer(psb_ipk_), intent(in)                :: val
-!!$      integer(psb_ipk_), intent(out)               :: info
-!!$    end subroutine amg_c_ainv_solver_seti
-!!$  end interface
-!!$
-!!$  interface
-!!$    subroutine amg_c_ainv_solver_setr(sv,what,val,info)
-!!$      import :: amg_c_ainv_solver_type, psb_ipk_, psb_spk_
-!!$      Implicit none
-!!$      ! Arguments
-!!$      class(amg_c_ainv_solver_type), intent(inout) :: sv
-!!$      integer(psb_ipk_), intent(in)                :: what
-!!$      real(psb_spk_), intent(in)                   :: val
-!!$      integer(psb_ipk_), intent(out)               :: info
-!!$    end subroutine amg_c_ainv_solver_setr
-!!$  end interface
+  interface
+    subroutine amg_c_ainv_solver_setc(sv,what,val,info)
+      import :: amg_c_ainv_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_c_ainv_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      character(len=*), intent(in)                 :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_c_ainv_solver_setc
+  end interface
 
   interface
-    subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse,prefix)
+    subroutine amg_c_ainv_solver_seti(sv,what,val,info)
+      import :: amg_c_ainv_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_c_ainv_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      integer(psb_ipk_), intent(in)                :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_c_ainv_solver_seti
+  end interface
+
+  interface
+    subroutine amg_c_ainv_solver_setr(sv,what,val,info)
+      import :: amg_c_ainv_solver_type, psb_ipk_, psb_spk_
+      Implicit none
+      ! Arguments
+      class(amg_c_ainv_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      real(psb_spk_), intent(in)                   :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_c_ainv_solver_setr
+  end interface
+
+  interface
+    subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse)
       import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
 
       Implicit None
@@ -219,7 +206,7 @@ module amg_c_ainv_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-      character(len=*), intent(in), optional  :: prefix
+
     end subroutine amg_c_ainv_solver_descr
   end interface
 

amgprec/amg_c_as_smoother.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -396,23 +396,21 @@ contains
   end subroutine c_as_smoother_default
 
 
-  subroutine c_as_smoother_descr(sm,info,iout,coarse,prefix)
+  subroutine c_as_smoother_descr(sm,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_c_as_smoother_type), intent(in) :: sm
-    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional              :: coarse
-      character(len=*), intent(in), optional   :: prefix
+    integer(psb_ipk_), intent(out)                      :: info
+    integer(psb_ipk_), intent(in), optional             :: iout
+    logical, intent(in), optional             :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_c_as_smoother_descr'
     integer(psb_ipk_) :: iout_
     logical      :: coarse_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -426,21 +424,16 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
     if (.not.coarse_) then 
-      write(iout_,*) trim(prefix_), '  Additive Schwarz with  ',&
+      write(iout_,*) '  Additive Schwarz with  ',&
            &  sm%novr, ' overlap layers.'
-      write(iout_,*) trim(prefix_), '  Restrictor:  ',restrict_names(sm%restr)
-      write(iout_,*) trim(prefix_), '  Prolongator: ',prolong_names(sm%prol)
-      write(iout_,*) trim(prefix_), '  Local solver:'
+      write(iout_,*) '  Restrictor:  ',restrict_names(sm%restr)
+      write(iout_,*) '  Prolongator: ',prolong_names(sm%prol)
+      write(iout_,*) '  Local solver:'
     endif
     if (allocated(sm%sv)) then 
-      call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
+      call sm%sv%descr(info,iout_,coarse=coarse)
     end if
 
     call psb_erractionrestore(err_act)

amgprec/amg_c_base_aggregator_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -126,7 +126,7 @@ module amg_c_base_aggregator_mod
            & psb_c_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_c_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(inout)         :: desc_a
+      type(psb_desc_type), intent(in)            :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_sml_parms), intent(inout)         :: parms 
       type(psb_c_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -144,7 +144,7 @@ module amg_c_base_aggregator_mod
            & psb_c_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_c_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(inout)         :: desc_a
+      type(psb_desc_type), intent(in)            :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_sml_parms), intent(inout)         :: parms 
       type(psb_c_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -275,22 +275,15 @@ contains
     val = .false.
   end function amg_c_base_aggregator_xt_desc
 
-  subroutine  amg_c_base_aggregator_descr(ag,parms,iout,info,prefix)
+  subroutine  amg_c_base_aggregator_descr(ag,parms,iout,info)
     implicit none 
     class(amg_c_base_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
-    character(len=*), intent(in), optional  :: prefix
-    character(1024)    :: prefix_
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
-    write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info,prefix=prefix)
+    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info)
     
     return
   end subroutine amg_c_base_aggregator_descr

amgprec/amg_c_base_ainv_mod.f90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions

amgprec/amg_c_base_smoother_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -272,7 +272,7 @@ module amg_c_base_smoother_mod
   end interface
   
   interface 
-    subroutine amg_c_base_smoother_descr(sm,info,iout,coarse,prefix)
+    subroutine amg_c_base_smoother_descr(sm,info,iout,coarse)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
            & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
            & amg_c_base_smoother_type, psb_ipk_
@@ -281,7 +281,6 @@ module amg_c_base_smoother_mod
       integer(psb_ipk_), intent(out)                :: info
       integer(psb_ipk_), intent(in), optional       :: iout
       logical, intent(in), optional                 :: coarse
-      character(len=*), intent(in), optional        :: prefix
     end subroutine amg_c_base_smoother_descr
   end interface
   

amgprec/amg_c_base_solver_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -270,7 +270,7 @@ module amg_c_base_solver_mod
   end interface
   
   interface
-    subroutine amg_c_base_solver_descr(sv,info,iout,coarse,prefix)
+    subroutine amg_c_base_solver_descr(sv,info,iout,coarse)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
            & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
            & amg_c_base_solver_type, psb_ipk_
@@ -281,7 +281,7 @@ module amg_c_base_solver_mod
       integer(psb_ipk_), intent(out)              :: info
       integer(psb_ipk_), intent(in), optional     :: iout
       logical, intent(in), optional               :: coarse
-      character(len=*), intent(in), optional      :: prefix
+
     end subroutine amg_c_base_solver_descr
   end interface 
   

amgprec/amg_c_dec_aggregator_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -184,23 +184,16 @@ contains
     val = "Decoupled aggregation"
   end function amg_c_dec_aggregator_fmt
   
-  subroutine  amg_c_dec_aggregator_descr(ag,parms,iout,info,prefix)
+  subroutine  amg_c_dec_aggregator_descr(ag,parms,iout,info)
     implicit none 
     class(amg_c_dec_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
-    character(len=*), intent(in), optional  :: prefix
-    character(1024)    :: prefix_
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
-    write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
-    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info,prefix=prefix)
+    write(iout,*) 'Decoupled Aggregator'
+    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info)
     
     return
   end subroutine amg_c_dec_aggregator_descr

amgprec/amg_c_diag_solver.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -219,7 +219,7 @@ contains
 
   end subroutine c_diag_solver_free
 
-  subroutine c_diag_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine c_diag_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
@@ -228,13 +228,11 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
-    character(len=*), intent(in), optional      :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_c_diag_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -242,13 +240,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    write(iout_,*) trim(prefix_), '  Diagonal local solver '
+    
+    write(iout_,*) '  Diagonal local solver '
 
     return
 
@@ -359,7 +352,7 @@ module amg_c_l1_diag_solver
   
 contains
 
-  subroutine c_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine c_l1_diag_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
@@ -368,13 +361,11 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
-    character(len=*), intent(in), optional  :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_c_l1_diag_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -382,13 +373,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    write(iout_,*) trim(prefix_), '  L1 Diagonal solver '
+    
+    write(iout_,*) '  L1 Diagonal solver '
 
     return
 

amgprec/amg_c_gs_solver.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -433,22 +433,20 @@ contains
     return
   end subroutine c_gs_solver_free
 
-  subroutine c_gs_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine c_gs_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_c_gs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
+    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(in), optional    :: iout
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_c_gs_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -457,17 +455,12 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     
@@ -533,22 +526,20 @@ contains
     val = .true.
   end function c_gs_solver_is_iterative
     
-  subroutine c_bwgs_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine c_bwgs_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_c_bwgs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional               :: coarse
-    character(len=*), intent(in), optional      :: prefix
+    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(in), optional    :: iout
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_c_bwgs_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -557,17 +548,12 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     

amgprec/amg_c_hybrid_aggregator_mod.F90

@@ -2,7 +2,7 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
 !    (C) Copyright 2020 
 !  

amgprec/amg_c_id_solver.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -157,7 +157,7 @@ contains
     return
   end subroutine c_id_solver_free
 
-  subroutine c_id_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine c_id_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
@@ -165,14 +165,12 @@ contains
     class(amg_c_id_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)            :: info
     integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_c_id_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -180,13 +178,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
     
-    write(iout_,*) trim(prefix_), '  Identity local solver '
+    write(iout_,*) '  Identity local solver '
 
     return
 

amgprec/amg_c_ilu_fact_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   

amgprec/amg_c_ilu_solver.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -234,7 +234,7 @@ contains
     ! Arguments
     class(amg_c_ilu_solver_type), intent(inout) :: sv
 
-    sv%fact_type = amg_ilu_n_
+    sv%fact_type = psb_ilu_n_
     sv%fill_in   = 0
     sv%thresh    = szero
 
@@ -255,13 +255,13 @@ contains
     info = psb_success_
 
     call amg_check_def(sv%fact_type,&
-         & 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
+         & 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
 
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
+    case(psb_ilu_n_,psb_milu_n_)      
       call amg_check_def(sv%fill_in,&
            & 'Level',izero,is_int_non_negative)
-    case(amg_ilu_t_)                 
+    case(psb_ilu_t_)                 
       call amg_check_def(sv%thresh,&
            & 'Eps',szero,is_legal_s_fact_thrs)
     end select
@@ -406,7 +406,7 @@ contains
     return
   end subroutine c_ilu_solver_free
 
-  subroutine c_ilu_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine c_ilu_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
@@ -414,14 +414,12 @@ contains
     class(amg_c_ilu_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional              :: coarse
-    character(len=*), intent(in), optional  :: prefix
-      
+    logical, intent(in), optional       :: coarse
+
     ! Local variables
     integer(psb_ipk_) :: err_act
     character(len=20), parameter :: name='amg_c_ilu_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -430,20 +428,15 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
-    write(iout_,*) trim(prefix_), '  Incomplete factorization solver: ',&
+    write(iout_,*) '  Incomplete factorization solver: ',&
          &  amg_fact_names(sv%fact_type)
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
-      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-    case(amg_ilu_t_)         
-      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-      write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
+    case(psb_ilu_n_,psb_milu_n_)      
+      write(iout_,*) '  Fill level:',sv%fill_in
+    case(psb_ilu_t_)         
+      write(iout_,*) '  Fill level:',sv%fill_in
+      write(iout_,*) '  Fill threshold :',sv%thresh
     end select
 
     call psb_erractionrestore(err_act)
@@ -496,7 +489,7 @@ contains
     implicit none 
     integer(psb_ipk_)  :: val
     
-    val = amg_ilu_n_
+    val = psb_ilu_n_
   end function c_ilu_solver_get_id
 
   function c_ilu_solver_get_wrksize() result(val)

amgprec/amg_c_inner_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -39,7 +39,7 @@
 !
 ! Module: amg_inner_mod
 !
-!  This module defines the interfaces to inner AMG4PSBLAS routines.
+!  This module defines the interfaces to inner MLD2P4 routines.
 !  The interfaces  of the user level routines are defined in amg_prec_mod.f90.
 !
 module amg_c_inner_mod

amgprec/amg_c_invk_solver.f90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -52,9 +49,10 @@ module amg_c_invk_solver
   contains
     procedure, pass(sv) :: check   => amg_c_invk_solver_check
     procedure, pass(sv) :: clone   => amg_c_invk_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_c_invk_solver_clone_settings
     procedure, pass(sv) :: build   => amg_c_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_c_invk_solver_cseti
+    procedure, pass(sv) :: seti    => amg_c_invk_solver_seti
+    generic, public     :: set     => seti
     procedure, pass(sv) :: descr   => amg_c_invk_solver_descr
     procedure, pass(sv) :: default => c_invk_solver_default
   end type amg_c_invk_solver_type
@@ -74,17 +72,6 @@ module amg_c_invk_solver
     end subroutine amg_c_invk_solver_clone
   end interface
 
-  interface
-    subroutine amg_c_invk_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
-       & amg_c_base_solver_type, psb_spk_, amg_c_invk_solver_type, psb_ipk_
-      Implicit None
-      class(amg_c_invk_solver_type), intent(inout)              :: sv
-      class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_c_invk_solver_clone_settings
-  end interface
-
   interface
     subroutine amg_c_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
@@ -135,7 +122,7 @@ module amg_c_invk_solver
   end interface
 
   interface
-    subroutine amg_c_invk_solver_descr(sv,info,iout,coarse,prefix)
+    subroutine amg_c_invk_solver_descr(sv,info,iout,coarse)
       import :: psb_spk_, amg_c_invk_solver_type, psb_ipk_
 
       Implicit None
@@ -145,10 +132,22 @@ module amg_c_invk_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-      character(len=*), intent(in), optional  :: prefix
+
     end subroutine amg_c_invk_solver_descr
   end interface
 
+  interface
+    subroutine amg_c_invk_solver_seti(sv,what,val,info)
+      import :: amg_c_invk_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_c_invk_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      integer(psb_ipk_), intent(in)                :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_c_invk_solver_seti
+  end interface
+
 contains
 
   subroutine c_invk_solver_default(sv)

amgprec/amg_c_invt_solver.f90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -52,10 +49,12 @@ module amg_c_invt_solver
   contains
     procedure, pass(sv) :: check   => amg_c_invt_solver_check
     procedure, pass(sv) :: clone   => amg_c_invt_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_c_invt_solver_clone_settings
     procedure, pass(sv) :: build   => amg_c_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_c_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_c_invt_solver_csetr
+    procedure, pass(sv) :: seti    => amg_c_invt_solver_seti
+    procedure, pass(sv) :: setr    => amg_c_invt_solver_setr
+    generic, public     :: set     => seti, setr
     procedure, pass(sv) :: descr   => amg_c_invt_solver_descr
     procedure, pass(sv) :: default => c_invt_solver_default
   end type amg_c_invt_solver_type
@@ -74,17 +73,6 @@ module amg_c_invt_solver
     end subroutine amg_c_invt_solver_clone
   end interface
 
-  interface
-    subroutine amg_c_invt_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
-       & amg_c_base_solver_type, psb_spk_, amg_c_invt_solver_type, psb_ipk_
-      Implicit None
-      class(amg_c_invt_solver_type), intent(inout)              :: sv
-      class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_c_invt_solver_clone_settings
-  end interface
-
   interface
     subroutine amg_c_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
@@ -146,21 +134,44 @@ module amg_c_invt_solver
   end interface
 
   interface
-    subroutine amg_c_invt_solver_descr(sv,info,iout,coarse,prefix)
+    subroutine amg_c_invt_solver_descr(sv,info,iout,coarse)
       import :: psb_spk_, amg_c_invt_solver_type, psb_ipk_
 
       Implicit None
 
       ! Arguments
       class(amg_c_invt_solver_type), intent(in) :: sv
-      integer(psb_ipk_), intent(out)              :: info
-      integer(psb_ipk_), intent(in), optional     :: iout
-      logical, intent(in), optional               :: coarse
-      character(len=*), intent(in), optional      :: prefix
+      integer(psb_ipk_), intent(out)            :: info
+      integer(psb_ipk_), intent(in), optional   :: iout
+      logical, intent(in), optional             :: coarse
 
     end subroutine amg_c_invt_solver_descr
   end interface
 
+  interface
+    subroutine amg_c_invt_solver_setr(sv,what,val,info)
+      import :: amg_c_invt_solver_type, psb_spk_, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_c_invt_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      real(psb_spk_), intent(in)                   :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_c_invt_solver_setr
+  end interface
+
+  interface
+    subroutine amg_c_invt_solver_seti(sv,what,val,info)
+      import :: amg_c_invt_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_c_invt_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      integer(psb_ipk_), intent(in)                :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine
+  end interface
+
 contains
 
   subroutine c_invt_solver_default(sv)

amgprec/amg_c_jac_smoother.f90

@@ -2,9 +2,9 @@
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !
-!    (C) Copyright 2021
+!    (C) Copyright 2020
 !
 !        Salvatore Filippone
 !        Pasqua D'Ambra
@@ -219,13 +219,12 @@ module amg_c_jac_smoother
   end interface
 
   interface
-    subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse,prefix)
+    subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse)
       import :: amg_c_jac_smoother_type, psb_ipk_
       class(amg_c_jac_smoother_type), intent(in) :: sm
       integer(psb_ipk_), intent(out)               :: info
       integer(psb_ipk_), intent(in), optional      :: iout
-      logical, intent(in), optional                :: coarse
-      character(len=*), intent(in), optional       :: prefix
+      logical, intent(in), optional              :: coarse
     end subroutine amg_c_jac_smoother_descr
   end interface
 
@@ -314,13 +313,12 @@ module amg_c_jac_smoother
   end interface
 
   interface
-    subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
+    subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse)
       import :: amg_c_l1_jac_smoother_type, psb_ipk_
       class(amg_c_l1_jac_smoother_type), intent(in) :: sm
-      integer(psb_ipk_), intent(out)                  :: info
-      integer(psb_ipk_), intent(in), optional         :: iout
-      logical, intent(in), optional                   :: coarse
-      character(len=*), intent(in), optional          :: prefix
+      integer(psb_ipk_), intent(out)               :: info
+      integer(psb_ipk_), intent(in), optional      :: iout
+      logical, intent(in), optional              :: coarse
     end subroutine amg_c_l1_jac_smoother_descr
   end interface
 

amgprec/amg_c_jac_solver.f90

@@ -1,585 +0,0 @@
-!  
-!   
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!   
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
-!
-!
-! File: amg_c_jac_solver_mod.f90
-!
-! Module: amg_c_jac_solver_mod
-!
-!  This module defines: 
-!  - the amg_c_jac_solver_type data structure containing the ingredients
-!    for a local Jacobi  iteration. The iterations are local to a process
-!    (they operate on the block diagonal).
-!    
-!
-module amg_c_jac_solver
-
-  use amg_c_base_solver_mod
-
-  type, extends(amg_c_base_solver_type) :: amg_c_jac_solver_type
-    type(psb_cspmat_type)      :: a
-    type(psb_c_vect_type), allocatable :: dv
-    complex(psb_spk_), allocatable        :: d(:)
-    integer(psb_ipk_)          :: sweeps
-    real(psb_spk_)             :: eps
-  contains
-    procedure, pass(sv) :: dump    => amg_c_jac_solver_dmp
-    procedure, pass(sv) :: check   => c_jac_solver_check
-    procedure, pass(sv) :: clone   => amg_c_jac_solver_clone
-    procedure, pass(sv) :: clone_settings => amg_c_jac_solver_clone_settings
-    procedure, pass(sv) :: clear_data     => amg_c_jac_solver_clear_data
-    procedure, pass(sv) :: build   => amg_c_jac_solver_bld
-    procedure, pass(sv) :: cnv     => amg_c_jac_solver_cnv
-    procedure, pass(sv) :: apply_v => amg_c_jac_solver_apply_vect
-    procedure, pass(sv) :: apply_a => amg_c_jac_solver_apply
-    procedure, pass(sv) :: free    => c_jac_solver_free
-    procedure, pass(sv) :: cseti   => c_jac_solver_cseti
-    procedure, pass(sv) :: csetc   => c_jac_solver_csetc
-    procedure, pass(sv) :: csetr   => c_jac_solver_csetr
-    procedure, pass(sv) :: descr   => c_jac_solver_descr
-    procedure, pass(sv) :: default => c_jac_solver_default
-    procedure, pass(sv) :: sizeof  => c_jac_solver_sizeof
-    procedure, pass(sv) :: get_nzeros => c_jac_solver_get_nzeros
-    procedure, nopass   :: get_wrksz  => c_jac_solver_get_wrksize
-    procedure, nopass   :: get_fmt    => c_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => c_jac_solver_get_id
-    procedure, nopass   :: is_iterative => c_jac_solver_is_iterative
-  end type amg_c_jac_solver_type
-
-  type, extends(amg_c_jac_solver_type) :: amg_c_l1_jac_solver_type
-  contains
-    procedure, pass(sv) :: build   => amg_c_l1_jac_solver_bld
-    procedure, pass(sv) :: descr   => c_l1_jac_solver_descr
-    procedure, nopass   :: get_fmt    => c_l1_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => c_l1_jac_solver_get_id
-  end type amg_c_l1_jac_solver_type
-
-
-  private :: c_jac_solver_bld, c_jac_solver_apply, &
-       &  c_jac_solver_free,   &
-       &  c_jac_solver_descr,  c_jac_solver_sizeof, &
-       &  c_jac_solver_default, c_jac_solver_dmp, &
-       &  c_jac_solver_apply_vect, c_jac_solver_get_nzeros, &
-       &  c_jac_solver_get_fmt, c_jac_solver_check,&
-       &  c_jac_solver_is_iterative, &
-       &  c_jac_solver_get_id, c_jac_solver_get_wrksize
-
-  interface 
-    subroutine amg_c_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,work,wv,info,init,initu)
-      import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
-           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)             :: desc_data
-      class(amg_c_jac_solver_type), intent(inout) :: sv
-      type(psb_c_vect_type),intent(inout)         :: x
-      type(psb_c_vect_type),intent(inout)         :: y
-      complex(psb_spk_),intent(in)                    :: alpha,beta
-      character(len=1),intent(in)                   :: trans
-      complex(psb_spk_),target, intent(inout)         :: work(:)
-      type(psb_c_vect_type),intent(inout)         :: wv(:)
-      integer(psb_ipk_), intent(out)                :: info
-      character, intent(in), optional                :: init
-      type(psb_c_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_c_jac_solver_apply_vect
-  end interface
-
-  interface 
-    subroutine amg_c_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
-      import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
-           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_c_jac_solver_type), intent(inout) :: sv
-      complex(psb_spk_),intent(inout)         :: x(:)
-      complex(psb_spk_),intent(inout)         :: y(:)
-      complex(psb_spk_),intent(in)            :: alpha,beta
-      character(len=1),intent(in)           :: trans
-      complex(psb_spk_),target, intent(inout) :: work(:)
-      integer(psb_ipk_), intent(out)        :: info
-      character, intent(in), optional       :: init
-      complex(psb_spk_),intent(inout), optional :: initu(:)
-    end subroutine amg_c_jac_solver_apply
-  end interface
-
-  interface 
-    subroutine amg_c_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
-           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_cspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_c_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_cspmat_type), intent(in), target, optional :: b
-      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
-    end subroutine amg_c_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_c_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_c_l1_jac_solver_type, psb_c_vect_type, psb_spk_, &
-           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_cspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_c_l1_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_cspmat_type), intent(in), target, optional :: b
-      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
-    end subroutine amg_c_l1_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_c_jac_solver_cnv(sv,info,amold,vmold,imold)
-      import :: amg_c_jac_solver_type, psb_spk_, &
-           & psb_c_base_sparse_mat, psb_c_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      class(amg_c_jac_solver_type), intent(inout)         :: sv
-      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
-    end subroutine amg_c_jac_solver_cnv
-  end interface
-  
-  interface 
-    subroutine amg_c_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
-      import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
-           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, &
-           & psb_ipk_
-      implicit none 
-      class(amg_c_jac_solver_type), intent(in) :: sv
-      type(psb_desc_type), intent(in)             :: desc
-      integer(psb_ipk_), intent(in)              :: level
-      integer(psb_ipk_), intent(out)             :: info
-      character(len=*), intent(in), optional     :: prefix, head
-      logical, optional, intent(in)              :: solver, global_num
-    end subroutine amg_c_jac_solver_dmp
-  end interface
-  
-  interface
-    subroutine amg_c_jac_solver_clone(sv,svout,info)
-      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
-           & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
-           & amg_c_base_solver_type, amg_c_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_c_jac_solver_type), intent(inout)               :: sv
-      class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)              :: info
-    end subroutine amg_c_jac_solver_clone
-  end interface
-  
-!!$  interface
-!!$    subroutine amg_c_l1_jac_solver_clone(sv,svout,info)
-!!$      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
-!!$           & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
-!!$           & amg_c_base_solver_type, amg_c_l1_jac_solver_type, psb_ipk_
-!!$      Implicit None
-!!$      
-!!$      ! Arguments
-!!$      class(amg_c_l1_jac_solver_type), intent(inout)               :: sv
-!!$      class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
-!!$      integer(psb_ipk_), intent(out)              :: info
-!!$    end subroutine amg_c_l1_jac_solver_clone
-!!$  end interface
-
-  interface
-    subroutine amg_c_jac_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
-           & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
-           & amg_c_base_solver_type, amg_c_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_c_jac_solver_type), intent(inout) :: sv
-      class(amg_c_base_solver_type), intent(inout) :: svout
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_c_jac_solver_clone_settings
-  end interface
-
-  interface
-    subroutine amg_c_jac_solver_clear_data(sv,info)
-      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
-           & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
-           & amg_c_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_c_jac_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(out)                 :: info
-    end subroutine amg_c_jac_solver_clear_data
-  end interface
-
-contains
-
-  subroutine c_jac_solver_default(sv)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(inout) :: sv
-
-    sv%sweeps = ione
-    sv%eps    = dzero
-    
-    return
-  end subroutine c_jac_solver_default
-
-  subroutine c_jac_solver_check(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20) :: name='c_jac_solver_check'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call amg_check_def(sv%sweeps,&
-         & 'Jacobi sweeps',ione,is_int_positive)
-
-    if (info /= psb_success_) goto 9999
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine c_jac_solver_check
-
-  subroutine c_jac_solver_cseti(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    integer(psb_ipk_), intent(in)                 :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='c_jac_solver_cseti'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-    select case(psb_toupper(what))
-    case('SOLVER_SWEEPS')
-      sv%sweeps = val      
-    case default
-      call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_jac_solver_cseti
-
-  subroutine c_jac_solver_csetc(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(inout) :: sv
-    character(len=*), intent(in)                  :: what 
-    character(len=*), intent(in)                  :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act, ival
-    character(len=20)  :: name='c_jac_solver_csetc'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-
-    call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
-  
-    if (info /= psb_success_) then
-      info = psb_err_from_subroutine_
-      call psb_errpush(info, name)
-      goto 9999
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_jac_solver_csetc
-  
-  subroutine c_jac_solver_csetr(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    real(psb_spk_), intent(in)                     :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='c_jac_solver_csetr'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    select case(psb_toupper(what))
-    case('SOLVER_EPS') 
-      sv%eps = val
-    case default
-      call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_jac_solver_csetr
-
-  subroutine c_jac_solver_free(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='c_jac_solver_free'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call sv%a%free()
-    if (allocated(sv%dv)) then
-      call sv%dv%free(info)
-      deallocate(sv%dv)
-    end if
-    if (allocated(sv%d)) deallocate(sv%d)
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_jac_solver_free
-
-  subroutine c_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_c_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_jac_solver_descr
-
-  function c_jac_solver_get_nzeros(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-    
-    val = 0 
-    val = val + sv%a%get_nzeros()
-    val = val + sv%dv%get_nrows()
-
-    return
-  end function c_jac_solver_get_nzeros
-
-  function c_jac_solver_sizeof(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-
-    val = psb_sizeof_ip 
-    val = val + sv%a%sizeof()
-    val = val + sv%dv%sizeof()
-
-    return
-  end function c_jac_solver_sizeof
-
-  function c_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "Jacobi solver"
-  end function c_jac_solver_get_fmt
-
-  function c_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_jac_
-  end function c_jac_solver_get_id
-
-  !
-  ! If this is true, then the solver needs a starting
-  ! guess. Currently only handled in JAC smoother. 
-  ! 
-  function c_jac_solver_is_iterative() result(val)
-    implicit none 
-    logical  :: val
-
-    val = .true.
-  end function c_jac_solver_is_iterative
-    
-  function c_jac_solver_get_wrksize() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = 2
-  end function c_jac_solver_get_wrksize
-
-  subroutine c_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_l1_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_c_l1_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_l1_jac_solver_descr
-
-  function c_l1_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "L1-Jacobi solver"
-  end function c_l1_jac_solver_get_fmt
-
-  function c_l1_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_l1_jac_
-  end function c_l1_jac_solver_get_id
-  
-end module amg_c_jac_solver

amgprec/amg_c_mumps_solver.F90

@@ -3,9 +3,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -78,8 +78,7 @@ module amg_c_mumps_solver
     !
     ! Controls to be set before MUMPS instantiation:
     !
-    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: 'LOCAL_SOLVER
-    !                            1==amg_global_solver_: 'GLOBAL_SOLVER'
+    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: LOCAL   1==amg_global_solver_: GLOBAL
     ! IPAR(2) : MUMPS_PRINT_ERR  print verbosity (see MUMPS)
     ! IPAR(3) : MUMPS_SYM        0: non-symmetric   2: symmetric
     integer(psb_ipk_), dimension(3) :: ipar
@@ -314,24 +313,22 @@ subroutine c_mumps_solver_finalize(sv)
 
 end subroutine c_mumps_solver_finalize
 
-subroutine c_mumps_solver_descr(sv,info,iout,coarse,prefix)
+subroutine c_mumps_solver_descr(sv,info,iout,coarse)
 
   Implicit None
 
   ! Arguments
   class(amg_c_mumps_solver_type), intent(in) :: sv
-  integer(psb_ipk_), intent(out)               :: info
-  integer(psb_ipk_), intent(in), optional      :: iout
-  logical, intent(in), optional                :: coarse
-  character(len=*), intent(in), optional       :: prefix
-      
+  integer(psb_ipk_), intent(out)                     :: info
+  integer(psb_ipk_), intent(in), optional            :: iout
+  logical, intent(in), optional       :: coarse
+
   ! Local variables
   integer(psb_ipk_)   :: err_act
   type(psb_ctxt_type) :: ctxt
   integer(psb_ipk_)   :: me, np
   character(len=20), parameter :: name='amg_z_mumps_solver_descr'
   integer(psb_ipk_) :: iout_
-  character(1024)    :: prefix_
 
   call psb_erractionsave(err_act)
   info = psb_success_
@@ -340,13 +337,8 @@ subroutine c_mumps_solver_descr(sv,info,iout,coarse,prefix)
   else
     iout_ = psb_out_unit
   endif
-  if (present(prefix)) then
-    prefix_ = prefix
-  else
-    prefix_ = ""
-  end if
 
-  write(iout_,*) trim(prefix_), '  MUMPS  Solver. '
+  write(iout_,*) '  MUMPS  Solver. '
 
   call psb_erractionrestore(err_act)
   return

amgprec/amg_c_onelev_mod.f90

@@ -1,15 +1,15 @@
-!
-!
+!  
+!   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2020 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
 !    are met:
@@ -21,7 +21,7 @@
 !      3. The name of the AMG4PSBLAS group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
-!
+!   
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -33,22 +33,22 @@
 !    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
-!
-!
+!   
+!  
 ! File: amg_c_onelev_mod.f90
 !
 ! Module: amg_c_onelev_mod
 !
-!  This module defines:
+!  This module defines: 
 !  - the amg_c_onelev_type data structure containing one level
 !    of a multilevel  preconditioner and related
 !    data structures;
 !
 !  It contains routines for
-!  - Building and applying;
+!  - Building and applying; 
 !  - checking if the preconditioner is correctly defined;
 !  - printing a	description of the preconditioner;
-!  - deallocating the preconditioner data structure.
+!  - deallocating the preconditioner data structure.  
 !
 
 module amg_c_onelev_mod
@@ -56,7 +56,6 @@ module amg_c_onelev_mod
   use amg_base_prec_type
   use amg_c_base_smoother_mod
   use amg_c_dec_aggregator_mod
-
   use psb_base_mod, only : psb_cspmat_type, psb_c_vect_type, &
        & psb_c_base_vect_type, psb_lcspmat_type,  psb_clinmap_type, psb_spk_, &
        & psb_ipk_, psb_epk_, psb_lpk_, psb_desc_type, psb_i_base_vect_type, &
@@ -74,16 +73,16 @@ module amg_c_onelev_mod
   !    class(amg_c_base_smoother_type), pointer       :: sm2 => null()
   !    class(amg_cmlprec_wrk_type), allocatable       :: wrk
   !    class(amg_c_base_aggregator_type), allocatable :: aggr
-  !    type(amg_sml_parms)             :: parms
+  !    type(amg_sml_parms)             :: parms 
   !    type(psb_cspmat_type)           :: ac
   !    type(psb_cesc_type)             :: desc_ac
-  !    type(psb_cspmat_type), pointer  :: base_a    => null()
-  !    type(psb_desc_type), pointer    :: base_desc => null()
+  !    type(psb_cspmat_type), pointer  :: base_a    => null() 
+  !    type(psb_desc_type), pointer    :: base_desc => null() 
   !    type(psb_clinmap_type)          :: map
   !  end type amg_conelev_type
   !
   !  Note that s denotes the kind of the real data type to be chosen
-  !  according to single/double precision version of AMG4PSBLAS.
+  !  according to single/double precision version of MLD2P4.
   !
   !   sm,sm2a      -  class(amg_c_base_smoother_type), allocatable
   !                   The current level pre- and post-smooother.
@@ -94,7 +93,7 @@ module amg_c_onelev_mod
   !                   Workspace for application of preconditioner; may be
   !                   pre-allocated to save time in the application within a
   !                   Krylov solver.
-  !   aggr         -  class(amg_c_base_aggregator_type), allocatable
+  !   aggr         -  class(amg_c_base_aggregator_type), allocatable 
   !                   The aggregator object: holds the algorithmic choices and
   !                   (possibly) additional data for building the aggregation.
   !   parms        -  type(amg_sml_parms)
@@ -105,7 +104,7 @@ module amg_c_onelev_mod
   !                   The communication descriptor associated to the matrix
   !                   stored in ac.
   !   base_a       -  type(psb_cspmat_type), pointer.
-  !                   Pointer (really a pointer!) to the local part of the current
+  !                   Pointer (really a pointer!) to the local part of the current 
   !                   matrix (so we have a unified treatment of residuals).
   !                   We need this to avoid passing explicitly the current matrix
   !                   to the routine which applies the preconditioner.
@@ -116,13 +115,13 @@ module amg_c_onelev_mod
   !                   vector spaces associated to the index spaces of the previous
   !                   and current levels.
   !
-  !   Methods:
+  !   Methods:  
   !     Most methods follow the encapsulation hierarchy: they take whatever action
   !     is appropriate for the current object, then call the corresponding method for
   !     the contained object.
   !     As an example: the descr() method prints out a description of the
   !     level. It starts by invoking the descr() method of the parms object,
-  !     then calls the descr() method of the smoother object.
+  !     then calls the descr() method of the smoother object. 
   !
   !    descr      -   Prints a description of the object.
   !    default    -   Set default values
@@ -131,14 +130,14 @@ module amg_c_onelev_mod
   !                   it is passed to the smoother object for further processing.
   !    check        -  Sanity checks.
   !    sizeof       -  Total memory occupation in bytes
-  !    get_nzeros   -  Number of nonzeros
+  !    get_nzeros   -  Number of nonzeros 
   !    get_wrksz    -  How many workspace vector does apply_vect need
   !    allocate_wrk -  Allocate auxiliary workspace
   !    free_wrk     -  Free     auxiliary workspace
   !    bld_tprol    -  Invoke the aggr method to build the tentative prolongator
-  !    mat_asb      -  Build the final (possibly smoothed) prolongator and coarse matrix.
-  !
+  !    mat_asb      -  Build the final (possibly smoothed) prolongator and coarse matrix. 
   !
+  !  
   type amg_cmlprec_wrk_type
     complex(psb_spk_), allocatable  :: tx(:), ty(:), x2l(:), y2l(:)
     type(psb_c_vect_type)  :: vtx, vty, vx2l, vy2l
@@ -149,35 +148,25 @@ module amg_c_onelev_mod
     procedure, pass(wk) :: clone      => c_wrk_clone
     procedure, pass(wk) :: move_alloc => c_wrk_move_alloc
     procedure, pass(wk) :: cnv        => c_wrk_cnv
-    procedure, pass(wk) :: sizeof     => c_wrk_sizeof
+    procedure, pass(wk) :: sizeof     => c_wrk_sizeof    
   end type amg_cmlprec_wrk_type
   private :: c_wrk_alloc, c_wrk_free, &
-       & c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv, c_wrk_sizeof
-
-  type amg_c_remap_data_type
-    type(psb_cspmat_type)          :: ac_pre_remap
-    type(psb_desc_type)            :: desc_ac_pre_remap
-    integer(psb_ipk_)              :: idest
-    integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
-  contains
-    procedure, pass(rmp) :: clone   => c_remap_data_clone
-  end type amg_c_remap_data_type
-
+       & c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv, c_wrk_sizeof    
+  
   type amg_c_onelev_type
     class(amg_c_base_smoother_type), allocatable   :: sm, sm2a
     class(amg_c_base_smoother_type), pointer       :: sm2 => null()
     class(amg_cmlprec_wrk_type), allocatable       :: wrk
     class(amg_c_base_aggregator_type), allocatable :: aggr
-    type(amg_sml_parms)              :: parms
+    type(amg_sml_parms)              :: parms 
     type(psb_cspmat_type)            :: ac
     integer(psb_ipk_)                :: ac_nz_loc
     integer(psb_lpk_)                :: ac_nz_tot
     type(psb_desc_type)              :: desc_ac
-    type(psb_cspmat_type), pointer   :: base_a    => null()
-    type(psb_desc_type), pointer     :: base_desc => null()
+    type(psb_cspmat_type), pointer   :: base_a    => null() 
+    type(psb_desc_type), pointer     :: base_desc => null() 
     type(psb_lcspmat_type)           :: tprol
-    type(psb_clinmap_type)           :: linmap
-    type(amg_c_remap_data_type)      :: remap_data
+    type(psb_clinmap_type)           :: map
     real(psb_spk_)                     :: szratio
   contains
     procedure, pass(lv) :: bld_tprol   => c_base_onelev_bld_tprol
@@ -187,10 +176,8 @@ module amg_c_onelev_mod
     procedure, pass(lv) :: clone   => c_base_onelev_clone
     procedure, pass(lv) :: cnv     => amg_c_base_onelev_cnv
     procedure, pass(lv) :: descr   => amg_c_base_onelev_descr
-    procedure, pass(lv) :: memory_use  => amg_c_base_onelev_memory_use
     procedure, pass(lv) :: default => c_base_onelev_default
     procedure, pass(lv) :: free    => amg_c_base_onelev_free
-    procedure, pass(lv) :: free_smoothers => amg_c_base_onelev_free_smoothers
     procedure, pass(lv) :: nullify => c_base_onelev_nullify
     procedure, pass(lv) :: check => amg_c_base_onelev_check
     procedure, pass(lv) :: dump  => amg_c_base_onelev_dump
@@ -200,7 +187,7 @@ module amg_c_onelev_mod
     procedure, pass(lv) :: setsm => amg_c_base_onelev_setsm
     procedure, pass(lv) :: setsv => amg_c_base_onelev_setsv
     procedure, pass(lv) :: setag => amg_c_base_onelev_setag
-    generic, public     :: set   => cseti, csetr, csetc, setsm, setsv, setag
+    generic, public     :: set   => cseti, csetr, csetc, setsm, setsv, setag 
     procedure, pass(lv) :: sizeof => c_base_onelev_sizeof
     procedure, pass(lv) :: get_nzeros => c_base_onelev_get_nzeros
     procedure, pass(lv) :: get_wrksz => c_base_onelev_get_wrksize
@@ -208,14 +195,7 @@ module amg_c_onelev_mod
     procedure, pass(lv) :: free_wrk       => c_base_onelev_free_wrk
     procedure, nopass   :: stringval => amg_stringval
     procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc
-
-
-    procedure, pass(lv) :: map_rstr_a => amg_c_base_onelev_map_rstr_a
-    procedure, pass(lv) :: map_prol_a => amg_c_base_onelev_map_prol_a
-    procedure, pass(lv) :: map_rstr_v => amg_c_base_onelev_map_rstr_v
-    procedure, pass(lv) :: map_prol_v => amg_c_base_onelev_map_prol_v
-    generic, public     :: map_rstr => map_rstr_a, map_rstr_v
-    generic, public     :: map_prol => map_prol_a, map_prol_v
+    
   end type amg_c_onelev_type
 
   type amg_c_onelev_node
@@ -229,11 +209,11 @@ module amg_c_onelev_mod
        & c_base_onelev_get_wrksize, c_base_onelev_allocate_wrk, &
        & c_base_onelev_free_wrk
 
-  interface
+  interface 
     subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
       import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lcspmat_type, psb_lpk_
       import :: amg_c_onelev_type
-      implicit none
+      implicit none 
       class(amg_c_onelev_type), intent(inout), target :: lv
       type(psb_cspmat_type), intent(in) :: a
       type(psb_desc_type), intent(inout)  :: desc_a
@@ -258,172 +238,141 @@ module amg_c_onelev_mod
     end subroutine amg_c_base_onelev_build
   end interface
 
-  interface
-    subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
+  interface 
+    subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
            & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
       ! Arguments
-      class(amg_c_onelev_type), intent(in)    :: lv
-      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
+      class(amg_c_onelev_type), intent(in) :: lv
+      integer(psb_ipk_), intent(in)                 :: il,nl,ilmin
+      integer(psb_ipk_), intent(out)                :: info
+      integer(psb_ipk_), intent(in), optional       :: iout
     end subroutine amg_c_base_onelev_descr
   end interface
 
-  interface
-    subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
-      import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
-           & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
-      Implicit None
-      ! Arguments
-      class(amg_c_onelev_type), intent(in)    :: lv
-      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_c_base_onelev_memory_use
-  end interface
-
-  interface
+  interface 
     subroutine amg_c_base_onelev_cnv(lv,info,amold,vmold,imold)
       import :: amg_c_onelev_type, psb_c_base_vect_type, psb_spk_, &
            & psb_c_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
       ! Arguments
-      class(amg_c_onelev_type), intent(inout)            :: lv
+      class(amg_c_onelev_type), intent(inout)            :: lv 
       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
     end subroutine amg_c_base_onelev_cnv
   end interface
-
-  interface
+   
+interface 
     subroutine amg_c_base_onelev_free(lv,info)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
            & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
-      implicit none
-
+      implicit none 
+      
       class(amg_c_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_c_base_onelev_free
   end interface
-
-  interface
-    subroutine amg_c_base_onelev_free_smoothers(lv,info)
-      import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
-           & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
-      implicit none
-
-      class(amg_c_onelev_type), intent(inout) :: lv
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_c_base_onelev_free_smoothers
-  end interface
-
-  interface
+  
+  interface 
     subroutine amg_c_base_onelev_check(lv,info)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
            & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
       ! Arguments
-      class(amg_c_onelev_type), intent(inout) :: lv
+      class(amg_c_onelev_type), intent(inout) :: lv 
       integer(psb_ipk_), intent(out)            :: info
     end subroutine amg_c_base_onelev_check
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_c_base_onelev_setsm(lv,val,info,pos)
       import :: psb_spk_, amg_c_onelev_type, amg_c_base_smoother_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
+      
       ! Arguments
-      class(amg_c_onelev_type), target, intent(inout) :: lv
+      class(amg_c_onelev_type), target, intent(inout) :: lv 
       class(amg_c_base_smoother_type), intent(in)     :: val
       integer(psb_ipk_), intent(out)                  :: info
       character(len=*), optional, intent(in)          :: pos
     end subroutine amg_c_base_onelev_setsm
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_c_base_onelev_setsv(lv,val,info,pos)
       import :: psb_spk_, amg_c_onelev_type, amg_c_base_solver_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
+      
       ! Arguments
-      class(amg_c_onelev_type), target, intent(inout) :: lv
+      class(amg_c_onelev_type), target, intent(inout) :: lv 
       class(amg_c_base_solver_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
       character(len=*), optional, intent(in)          :: pos
     end subroutine amg_c_base_onelev_setsv
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_c_base_onelev_setag(lv,val,info,pos)
       import :: psb_spk_, amg_c_onelev_type, amg_c_base_aggregator_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
+      
       ! Arguments
-      class(amg_c_onelev_type), target, intent(inout) :: lv
+      class(amg_c_onelev_type), target, intent(inout) :: lv 
       class(amg_c_base_aggregator_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
       character(len=*), optional, intent(in)          :: pos
     end subroutine amg_c_base_onelev_setag
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
            & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
+      
       ! Arguments
-      class(amg_c_onelev_type), intent(inout) :: lv
-      character(len=*), intent(in)              :: what
+      class(amg_c_onelev_type), intent(inout) :: lv 
+      character(len=*), intent(in)              :: what 
       integer(psb_ipk_), intent(in)             :: val
       integer(psb_ipk_), intent(out)            :: info
       character(len=*), optional, intent(in)      :: pos
     integer(psb_ipk_), intent(in), optional       :: idx
     end subroutine amg_c_base_onelev_cseti
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
            & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
       ! Arguments
-      class(amg_c_onelev_type), intent(inout) :: lv
-      character(len=*), intent(in)              :: what
+      class(amg_c_onelev_type), intent(inout) :: lv 
+      character(len=*), intent(in)              :: what 
       character(len=*), intent(in)              :: val
       integer(psb_ipk_), intent(out)            :: info
       character(len=*), optional, intent(in)      :: pos
     integer(psb_ipk_), intent(in), optional       :: idx
     end subroutine amg_c_base_onelev_csetc
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_c_base_onelev_csetr(lv,what,val,info,pos,idx)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
            & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
-      class(amg_c_onelev_type), intent(inout) :: lv
-      character(len=*), intent(in)              :: what
+      
+      class(amg_c_onelev_type), intent(inout) :: lv 
+      character(len=*), intent(in)              :: what 
       real(psb_spk_), intent(in)                 :: val
       integer(psb_ipk_), intent(out)            :: info
       character(len=*), optional, intent(in)      :: pos
@@ -431,13 +380,13 @@ module amg_c_onelev_mod
     end subroutine amg_c_base_onelev_csetr
   end interface
 
-  interface
+  interface 
     subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
          & solver,tprol,global_num)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
            & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
-      implicit none
+      implicit none 
       class(amg_c_onelev_type), intent(in) :: lv
       integer(psb_ipk_), intent(in)          :: level
       integer(psb_ipk_), intent(out)         :: info
@@ -445,62 +394,15 @@ module amg_c_onelev_mod
       logical, optional, intent(in)    :: ac, rp, smoother, solver, tprol, global_num
     end subroutine amg_c_base_onelev_dump
   end interface
-
-  interface
-    subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
-      import
-      implicit none
-      class(amg_c_onelev_type), target, intent(inout) :: lv
-      complex(psb_spk_), intent(in)     :: alpha, beta
-      complex(psb_spk_), intent(inout)   :: u(:)
-      complex(psb_spk_), intent(out)     :: v(:)
-      integer(psb_ipk_), intent(out) :: info
-      complex(psb_spk_), optional       :: work(:)
-    end subroutine amg_c_base_onelev_map_rstr_a
-    subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
-      import
-      implicit none
-      class(amg_c_onelev_type), target, intent(inout) :: lv
-      complex(psb_spk_), intent(in)           :: alpha, beta
-      type(psb_c_vect_type), intent(inout) :: vect_u, vect_v
-      integer(psb_ipk_), intent(out)       :: info
-      complex(psb_spk_), optional          :: work(:)
-      type(psb_c_vect_type), optional, target, intent(inout)  :: vtx,vty
-    end subroutine amg_c_base_onelev_map_rstr_v
-  end interface
-
-  interface
-    subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
-      import
-      implicit none
-      class(amg_c_onelev_type), target, intent(inout) :: lv
-      complex(psb_spk_), intent(in)     :: alpha, beta
-      complex(psb_spk_), intent(inout)   :: u(:)
-      complex(psb_spk_), intent(out)     :: v(:)
-      integer(psb_ipk_), intent(out) :: info
-      complex(psb_spk_), optional          :: work(:)
-
-    end subroutine amg_c_base_onelev_map_prol_a
-    subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
-      import
-      implicit none
-      class(amg_c_onelev_type), target, intent(inout) :: lv
-      complex(psb_spk_), intent(in)           :: alpha, beta
-      type(psb_c_vect_type), intent(inout) :: vect_u, vect_v
-      integer(psb_ipk_), intent(out)       :: info
-      complex(psb_spk_), optional          :: work(:)
-      type(psb_c_vect_type), optional, target, intent(inout)  :: vtx,vty
-    end subroutine amg_c_base_onelev_map_prol_v
-  end interface
-
+  
 contains
   !
   ! Function returning the size of the amg_prec_type data structure
-  ! in bytes or in number of nonzeros of the operator(s) involved.
+  ! in bytes or in number of nonzeros of the operator(s) involved. 
   !
 
   function c_base_onelev_get_nzeros(lv) result(val)
-    implicit none
+    implicit none 
     class(amg_c_onelev_type), intent(in) :: lv
     integer(psb_epk_) :: val
     integer(psb_ipk_)        :: i
@@ -512,16 +414,16 @@ contains
   end function c_base_onelev_get_nzeros
 
   function c_base_onelev_sizeof(lv) result(val)
-    implicit none
+    implicit none 
     class(amg_c_onelev_type), intent(in) :: lv
     integer(psb_epk_) :: val
     integer(psb_ipk_)        :: i
-
+    
     val = psb_sizeof_ip+psb_sizeof_lp
     val = val + lv%desc_ac%sizeof()
     val = val + lv%ac%sizeof()
     val = val + lv%tprol%sizeof()
-    val = val + lv%linmap%sizeof()
+    val = val + lv%map%sizeof() 
     if (allocated(lv%sm))   val = val + lv%sm%sizeof()
     if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
     if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -530,19 +432,19 @@ contains
 
 
   subroutine c_base_onelev_nullify(lv)
-    implicit none
+    implicit none 
 
     class(amg_c_onelev_type), intent(inout) :: lv
 
-    nullify(lv%base_a)
-    nullify(lv%base_desc)
+    nullify(lv%base_a) 
+    nullify(lv%base_desc) 
     nullify(lv%sm2)
   end subroutine c_base_onelev_nullify
 
   !
-  ! Multilevel defaults:
+  ! Multilevel defaults: 
   !  multiplicative vs. additive ML framework;
-  !  Smoothed decoupled aggregation with zero threshold;
+  !  Smoothed decoupled aggregation with zero threshold; 
   !  distributed coarse matrix;
   !  damping omega  computed with the max-norm estimate of the
   !  dominant eigenvalue;
@@ -552,10 +454,10 @@ contains
   subroutine c_base_onelev_default(lv)
 
     Implicit None
-
+ 
     ! Arguments
     class(amg_c_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_) :: info
+    integer(psb_ipk_) :: info 
 
     lv%parms%sweeps_pre      = 1
     lv%parms%sweeps_post     = 1
@@ -570,7 +472,7 @@ contains
     lv%parms%aggr_filter     = amg_no_filter_mat_
     lv%parms%aggr_omega_val  = szero
     lv%parms%aggr_thresh     = 0.01_psb_spk_
-
+    
     if (allocated(lv%sm)) call lv%sm%default()
     if (allocated(lv%sm2a)) then
       call lv%sm2a%default()
@@ -580,7 +482,7 @@ contains
     end if
     if (.not.allocated(lv%aggr)) allocate(amg_c_dec_aggregator_type :: lv%aggr,stat=info)
     if (allocated(lv%aggr)) call lv%aggr%default()
-
+    
     return
 
   end subroutine c_base_onelev_default
@@ -595,9 +497,9 @@ contains
     type(psb_lcspmat_type), intent(out)  :: t_prol
     type(amg_saggr_data), intent(in)    :: ag_data
     integer(psb_ipk_), intent(out)      :: info
-
+    
     call lv%aggr%bld_tprol(lv%parms,ag_data,a,desc_a,ilaggr,nlaggr,t_prol,info)
-
+    
   end subroutine c_base_onelev_bld_tprol
 
 
@@ -607,7 +509,7 @@ contains
     integer(psb_ipk_), intent(out)      :: info
 
     call lv%aggr%update_next(lvnext%aggr,info)
-
+    
   end subroutine c_base_onelev_update_aggr
 
 
@@ -616,33 +518,33 @@ contains
     Implicit None
 
     ! Arguments
-    class(amg_c_onelev_type), target, intent(inout) :: lv
+    class(amg_c_onelev_type), target, intent(inout) :: lv 
     class(amg_c_onelev_type), target, intent(inout) :: lvout
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
 
     info = psb_success_
-    if (allocated(lv%sm)) then
+    if (allocated(lv%sm)) then 
       call lv%sm%clone(lvout%sm,info)
-    else
-      if (allocated(lvout%sm)) then
+    else 
+      if (allocated(lvout%sm)) then 
         call lvout%sm%free(info)
         if (info==psb_success_) deallocate(lvout%sm,stat=info)
       end if
     end if
-    if (allocated(lv%sm2a)) then
+    if (allocated(lv%sm2a)) then 
       call lv%sm%clone(lvout%sm2a,info)
       lvout%sm2 => lvout%sm2a
-    else
-      if (allocated(lvout%sm2a)) then
+    else 
+      if (allocated(lvout%sm2a)) then 
         call lvout%sm2a%free(info)
         if (info==psb_success_) deallocate(lvout%sm2a,stat=info)
       end if
       lvout%sm2 => lvout%sm
     end if
-    if (allocated(lv%aggr)) then
+    if (allocated(lv%aggr)) then 
       call  lv%aggr%clone(lvout%aggr,info)
     else
-      if (allocated(lvout%aggr)) then
+      if (allocated(lvout%aggr)) then 
         call lvout%aggr%free(info)
         if (info==psb_success_) deallocate(lvout%aggr,stat=info)
       end if
@@ -651,11 +553,10 @@ contains
     if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
     if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
     if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
-    if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
-    if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
+    if (info == psb_success_) call lv%map%clone(lvout%map,info)
     lvout%base_a    => lv%base_a
     lvout%base_desc => lv%base_desc
-
+    
     return
 
   end subroutine c_base_onelev_clone
@@ -664,12 +565,12 @@ contains
     use psb_base_mod
     implicit none
     class(amg_c_onelev_type), target, intent(inout) :: lv, b
-    integer(psb_ipk_), intent(out) :: info
-
+    integer(psb_ipk_), intent(out) :: info 
+    
     call b%free(info)
     b%parms  = lv%parms
     b%szratio = lv%szratio
-    if (associated(lv%sm2,lv%sm2a)) then
+    if (associated(lv%sm2,lv%sm2a)) then 
       call move_alloc(lv%sm,b%sm)
       call move_alloc(lv%sm2a,b%sm2a)
       b%sm2 =>b%sm2a
@@ -680,18 +581,18 @@ contains
     end if
 
     call move_alloc(lv%aggr,b%aggr)
-    if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
-    if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
-    if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
-    if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
+    if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info) 
+    if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info) 
+    if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info) 
+    if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info) 
     b%base_a    => lv%base_a
     b%base_desc => lv%base_desc
-
+    
   end subroutine c_base_onelev_move_alloc
 
-
+  
   function c_base_onelev_get_wrksize(lv) result(val)
-    implicit none
+    implicit none 
     class(amg_c_onelev_type), intent(inout) :: lv
     integer(psb_ipk_)  :: val
 
@@ -712,54 +613,44 @@ contains
     select case(lv%parms%ml_cycle)
     case(amg_add_ml_,amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
       ! We're good
-
+      
     case(amg_kcycle_ml_, amg_kcyclesym_ml_)
       !
       ! We need 7 in inneritkcycle.
-      !  Can we reuse vtx?
-      !
+      !  Can we reuse vtx? 
+      ! 
       val = val + 7
-
+      
     case default
       ! Need a better error signaling ?
       val = -1
     end select
-
+    
   end function c_base_onelev_get_wrksize
 
   subroutine c_base_onelev_allocate_wrk(lv,info,vmold)
     use psb_base_mod
     implicit none
     class(amg_c_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
+    integer(psb_ipk_), intent(out) :: info 
     class(psb_c_base_vect_type), intent(in), optional  :: vmold
     !
     integer(psb_ipk_) :: nwv, i
     info = psb_success_
     nwv = lv%get_wrksz()
     if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
-    if (info == 0) then
-      if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
-        !
-        !  Need to fix this, we need two different allocations
-        !
-        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
-             & desc2=lv%remap_data%desc_ac_pre_remap)
-      else
-        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
-      end if
-    end if
-
+    if (info == 0) call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
+    
   end subroutine c_base_onelev_allocate_wrk
 
-
+  
   subroutine c_base_onelev_free_wrk(lv,info)
     use psb_base_mod
     implicit none
     class(amg_c_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
+    integer(psb_ipk_), intent(out) :: info 
     !
-    integer(psb_ipk_) :: nwv,i
+    integer(psb_ipk_) :: nwv,i 
     info = psb_success_
 
     if (allocated(lv%wrk)) then
@@ -767,88 +658,46 @@ contains
       if (info == 0) deallocate(lv%wrk,stat=info)
     end if
   end subroutine c_base_onelev_free_wrk
-
-  subroutine c_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
+  
+  subroutine c_wrk_alloc(wk,nwv,desc,info,vmold)
     use psb_base_mod
-
+    
     Implicit None
-
+    
     ! Arguments
     class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
     integer(psb_ipk_), intent(in)                     :: nwv
     type(psb_desc_type), intent(in)                   :: desc
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
     class(psb_c_base_vect_type), intent(in), optional  :: vmold
-    type(psb_desc_type), intent(in), optional          :: desc2
     !
     integer(psb_ipk_) :: i
 
     info = psb_success_
     call wk%free(info)
-    if  (present(desc2)) then
-!!$      write(0,*) 'Check on wrk_alloc 2',&
-!!$           & desc2%get_local_rows(), desc%get_local_rows(),&
-!!$           & desc2%get_local_cols(),desc%get_local_cols()
-!!$      flush(0)
-      if (desc2%get_local_cols()>desc%get_local_cols()) then
-        call psb_geasb(wk%vx2l,desc2,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vy2l,desc2,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vtx,desc2,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vty,desc2,info,&
-             & scratch=.true.,mold=vmold)
-        allocate(wk%wv(nwv),stat=info)
-        do i=1,nwv
-          call psb_geasb(wk%wv(i),desc2,info,&
-               & scratch=.true.,mold=vmold)
-        end do
-      else
-!!$        write(0,*) 'Check on wrk_alloc 1.5 ',&
-!!$             & desc%get_local_rows(),&
-!!$             & desc%get_local_cols()
-        call psb_geasb(wk%vx2l,desc,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vy2l,desc,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vtx,desc,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vty,desc,info,&
-             & scratch=.true.,mold=vmold)
-        allocate(wk%wv(nwv),stat=info)
-        do i=1,nwv
-          call psb_geasb(wk%wv(i),desc,info,&
-               & scratch=.true.,mold=vmold)
-        end do
-      end if
-    else
-!!$      write(0,*) 'Check on wrk_alloc 1 ',&
-!!$           & desc%get_local_rows(),&
-!!$           & desc%get_local_cols()
-      call psb_geasb(wk%vx2l,desc,info,&
+    call psb_geasb(wk%vx2l,desc,info,&
+         & scratch=.true.,mold=vmold)
+    call psb_geasb(wk%vy2l,desc,info,&
+         & scratch=.true.,mold=vmold)
+    call psb_geasb(wk%vtx,desc,info,&
+         & scratch=.true.,mold=vmold)
+    call psb_geasb(wk%vty,desc,info,&
+         & scratch=.true.,mold=vmold)
+    allocate(wk%wv(nwv),stat=info)
+    do i=1,nwv
+      call psb_geasb(wk%wv(i),desc,info,&
            & scratch=.true.,mold=vmold)
-      call psb_geasb(wk%vy2l,desc,info,&
-           & scratch=.true.,mold=vmold)
-      call psb_geasb(wk%vtx,desc,info,&
-           & scratch=.true.,mold=vmold)
-      call psb_geasb(wk%vty,desc,info,&
-           & scratch=.true.,mold=vmold)
-      allocate(wk%wv(nwv),stat=info)
-      do i=1,nwv
-        call psb_geasb(wk%wv(i),desc,info,&
-             & scratch=.true.,mold=vmold)
-      end do
-    end if
+    end do
+    
   end subroutine c_wrk_alloc
-
+    
   subroutine c_wrk_free(wk,info)
 
     Implicit None
 
     ! Arguments
     class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
     !
     integer(psb_ipk_) :: i
     info = psb_success_
@@ -869,7 +718,7 @@ contains
     end if
 
   end subroutine c_wrk_free
-
+    
   subroutine c_wrk_clone(wk,wkout,info)
     use psb_base_mod
     Implicit None
@@ -877,11 +726,11 @@ contains
     ! Arguments
     class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
     class(amg_cmlprec_wrk_type), target, intent(inout) :: wkout
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
     !
     integer(psb_ipk_) :: i
     info = psb_success_
-
+    
     call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
     call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
     call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
@@ -903,12 +752,12 @@ contains
     return
 
   end subroutine c_wrk_clone
-
+  
   subroutine c_wrk_move_alloc(wk, b,info)
     implicit none
     class(amg_cmlprec_wrk_type), target, intent(inout) :: wk, b
-    integer(psb_ipk_), intent(out) :: info
-
+    integer(psb_ipk_), intent(out) :: info 
+    
     call b%free(info)
     call move_alloc(wk%tx,b%tx)
     call move_alloc(wk%ty,b%ty)
@@ -921,17 +770,17 @@ contains
     call move_alloc(wk%vx2l%v,b%vx2l%v)
     call move_alloc(wk%vy2l%v,b%vy2l%v)
     call move_alloc(wk%wv,b%wv)
-
+        
   end subroutine c_wrk_move_alloc
 
   subroutine c_wrk_cnv(wk,info,vmold)
     use psb_base_mod
-
+    
     Implicit None
-
+    
     ! Arguments
     class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
     class(psb_c_base_vect_type), intent(in), optional  :: vmold
     !
     integer(psb_ipk_) :: i
@@ -952,7 +801,7 @@ contains
 
   function c_wrk_sizeof(wk) result(val)
     use psb_realloc_mod
-    implicit none
+    implicit none 
     class(amg_cmlprec_wrk_type), intent(in) :: wk
     integer(psb_epk_) :: val
     integer :: i
@@ -971,25 +820,5 @@ contains
       end do
     end if
   end function c_wrk_sizeof
-
-  subroutine c_remap_data_clone(rmp, remap_out, info)
-    use psb_base_mod
-    implicit none
-    ! Arguments
-    class(amg_c_remap_data_type), target, intent(inout) :: rmp
-    class(amg_c_remap_data_type), target, intent(inout) :: remap_out
-    integer(psb_ipk_), intent(out)                    :: info
-    !
-    integer(psb_ipk_) :: i
-
-    info = psb_success_
-
-    call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
-    if (info == psb_success_) &
-         & call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
-    remap_out%idest = rmp%idest
-    call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
-    call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
-  end subroutine c_remap_data_clone
-
+ 
 end module amg_c_onelev_mod

amgprec/amg_c_prec_mod.f90

@@ -2,9 +2,9 @@
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !
-!    (C) Copyright 2021
+!    (C) Copyright 2020
 !
 !        Salvatore Filippone
 !        Pasqua D'Ambra
@@ -40,7 +40,7 @@
 ! Module: amg_c_prec_mod
 !
 !  This module defines the user interfaces to the real/complex, single/double
-!  precision versions of the user-level AMG4PSBLAS routines.
+!  precision versions of the user-level MLD2P4 routines.
 !
 module amg_c_prec_mod
 
@@ -55,7 +55,12 @@ module amg_c_prec_mod
   use amg_c_ainv_solver
   use amg_c_invk_solver
   use amg_c_invt_solver
-  use amg_c_krm_solver
+
+  interface amg_precset
+    module procedure amg_c_iprecsetsm, amg_c_iprecsetsv, &
+         & amg_c_cprecseti, amg_c_cprecsetc, amg_c_cprecsetr, &
+         & amg_c_iprecsetag
+  end interface amg_precset
 
   interface amg_extprol_bld
     subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
@@ -77,4 +82,61 @@ module amg_c_prec_mod
     end subroutine amg_c_extprol_bld
   end interface amg_extprol_bld
 
+contains
+
+  subroutine amg_c_iprecsetsm(p,val,info,pos)
+    type(amg_cprec_type), intent(inout)    :: p
+    class(amg_c_base_smoother_type), intent(in)   :: val
+    integer(psb_ipk_), intent(out)           :: info
+    character(len=*), optional, intent(in)      :: pos
+
+    call p%set(val,info,pos=pos)
+  end subroutine amg_c_iprecsetsm
+
+  subroutine amg_c_iprecsetsv(p,val,info,pos)
+    type(amg_cprec_type), intent(inout)    :: p
+    class(amg_c_base_solver_type), intent(in)   :: val
+    integer(psb_ipk_), intent(out)                :: info
+    character(len=*), optional, intent(in)      :: pos
+    call p%set(val,info, pos=pos)
+  end subroutine amg_c_iprecsetsv
+
+  subroutine amg_c_iprecsetag(p,val,info,pos)
+    type(amg_cprec_type), intent(inout)    :: p
+    class(amg_c_base_aggregator_type), intent(in)   :: val
+    integer(psb_ipk_), intent(out)                :: info
+    character(len=*), optional, intent(in)      :: pos
+    call p%set(val,info, pos=pos)
+  end subroutine amg_c_iprecsetag
+
+  subroutine amg_c_cprecseti(p,what,val,info,pos)
+    type(amg_cprec_type), intent(inout)   :: p
+    character(len=*), intent(in)            :: what
+    integer(psb_ipk_), intent(in)           :: val
+    integer(psb_ipk_), intent(out)          :: info
+    character(len=*), optional, intent(in)      :: pos
+
+    call p%set(what,val,info,pos=pos)
+  end subroutine amg_c_cprecseti
+
+  subroutine amg_c_cprecsetr(p,what,val,info,pos)
+    type(amg_cprec_type), intent(inout)   :: p
+    character(len=*), intent(in)            :: what
+    real(psb_spk_), intent(in)             :: val
+    integer(psb_ipk_), intent(out)          :: info
+    character(len=*), optional, intent(in)      :: pos
+
+    call p%set(what,val,info,pos=pos)
+  end subroutine amg_c_cprecsetr
+
+  subroutine amg_c_cprecsetc(p,what,val,info,pos)
+    type(amg_cprec_type), intent(inout)   :: p
+    character(len=*), intent(in)            :: what
+    character(len=*), intent(in)            :: val
+    integer(psb_ipk_), intent(out)          :: info
+    character(len=*), optional, intent(in)      :: pos
+
+    call p%set(what,val,info,pos=pos)
+  end subroutine amg_c_cprecsetc
+
 end module amg_c_prec_mod

amgprec/amg_c_prec_type.f90

@@ -2,9 +2,9 @@
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !
-!    (C) Copyright 2021
+!    (C) Copyright 2020
 !
 !        Salvatore Filippone
 !        Pasqua D'Ambra
@@ -66,7 +66,7 @@ module amg_c_prec_type
   !
   !  This is the data type containing all the information about the multilevel
   !  preconditioner ('d', 's', 'c' and 'z', according to the real/complex,
-  !  single/double precision version of  AMG4PSBLAS).
+  !  single/double precision version of  MLD2P4).
   !  It consists of an array of 'one-level' intermediate data structures
   !  of type amg_conelev_type, each containing the information needed to apply
   !  the smoothing and the coarse-space correction at a generic level. RT is the
@@ -135,11 +135,8 @@ module amg_c_prec_type
     procedure, pass(prec)               :: build        => amg_cprecbld
     procedure, pass(prec)               :: hierarchy_build   => amg_c_hierarchy_bld
     procedure, pass(prec)               :: hierarchy_rebuild => amg_c_hierarchy_rebld
-    procedure, pass(prec)               :: hierarchy_free    => amg_c_hierarchy_free    
     procedure, pass(prec)               :: smoothers_build   => amg_c_smoothers_bld
-    procedure, pass(prec)               :: smoothers_free    => amg_c_smoothers_free
     procedure, pass(prec)               :: descr        =>  amg_cfile_prec_descr
-    procedure, pass(prec)               :: memory_use   =>  amg_cfile_prec_memory_use
   end type amg_cprec_type
 
   private :: amg_c_dump, amg_c_get_compl,  amg_c_cmp_compl,&
@@ -158,35 +155,16 @@ module amg_c_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity,prefix)
+    subroutine amg_cfile_prec_descr(prec,iout,root)
       import :: amg_cprec_type, psb_ipk_
       implicit none
       ! Arguments
-      class(amg_cprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out)          :: info
+      class(amg_cprec_type), intent(in)      :: prec
       integer(psb_ipk_), intent(in), optional :: iout
       integer(psb_ipk_), intent(in), optional :: root
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
     end subroutine amg_cfile_prec_descr
   end interface
 
-  
-  interface amg_memory_use
-    subroutine amg_cfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
-      import :: amg_cprec_type, psb_ipk_
-      implicit none
-      ! Arguments
-      class(amg_cprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: root
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_cfile_prec_memory_use
-  end interface
-
   interface amg_sizeof
     module procedure amg_cprec_sizeof
   end interface
@@ -364,14 +342,6 @@ module amg_c_prec_type
     end subroutine amg_c_smoothers_bld
   end interface amg_smoothers_bld
 
-  interface amg_smoothers_free
-    module procedure  amg_c_smoothers_free
-  end interface amg_smoothers_free
-
-  interface amg_hierarchy_free
-    module procedure amg_c_hierarchy_free
-  end interface amg_hierarchy_free
-
 contains
   !
   ! Function returning a pointer to the smoother
@@ -454,22 +424,11 @@ contains
     end if
   end function amg_c_get_nzeros
 
-  function amg_cprec_sizeof(prec, global) result(val)
+  function amg_cprec_sizeof(prec) result(val)
     implicit none
     class(amg_cprec_type), intent(in) :: prec
-    logical, intent(in), optional :: global
-    integer(psb_epk_) :: val    
+    integer(psb_epk_) :: val
     integer(psb_ipk_)        :: i
-    type(psb_ctxt_type) :: ctxt
-    
-    logical :: global_
-
-    if (present(global)) then
-      global_ = global
-    else
-      global_ = .false.
-    end if
-    
     val = 0
     val = val + psb_sizeof_ip
     if (allocated(prec%precv)) then
@@ -477,11 +436,6 @@ contains
         val = val + prec%precv(i)%sizeof()
       end do
     end if
-    if (global_) then
-      ctxt = prec%ctxt
-      call psb_sum(ctxt,val)
-    end if
-
   end function amg_cprec_sizeof
 
   !
@@ -645,68 +599,6 @@ contains
 
   end subroutine amg_c_prec_free
 
-  subroutine amg_c_smoothers_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_cprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_c_smoothers_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
-        call prec%precv(i)%free_smoothers(info)
-      end do
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_c_smoothers_free
-
-  subroutine amg_c_hierarchy_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_cprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_c_hierarchy_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    me=-1
-    write(0,*) 'Missing implementation '
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_c_hierarchy_free
 
 
   !
@@ -846,15 +738,16 @@ contains
     character(len=*), intent(in), optional  :: prefix, head
     logical, optional, intent(in)    :: smoother, solver,ac, rp, tprol, global_num
     integer(psb_ipk_)   :: i, j, il1, iln, lev
-    type(psb_ctxt_type) :: ctxt
+    type(psb_ctxt_type) :: icontxt
     integer(psb_ipk_)   :: iam, np, iproc_
     character(len=80)   :: prefix_
     character(len=120)  :: fname ! len should be at least 20 more than
     !  len of prefix_
 
     info = 0
-    ctxt = prec%ctxt
-    call psb_info(ctxt,iam,np)
+    icontxt = prec%ctxt
+    call psb_info(icontxt,iam,np)
+
     iln = size(prec%precv)
     if (present(istart)) then
       il1 = max(1,istart)
@@ -919,13 +812,13 @@ contains
     integer(psb_ipk_), intent(out)             :: info
     ! Local vars
     integer(psb_ipk_)   :: i, j, ln, lev
-    type(psb_ctxt_type) :: ctxt
+    type(psb_ctxt_type) :: icontxt
     integer(psb_ipk_)   :: iam, np
 
     info = psb_success_
     select type(pout => precout)
     class is (amg_cprec_type)
-      pout%ctxt          = prec%ctxt
+      pout%ctxt         = prec%ctxt
       pout%ag_data       = prec%ag_data
       pout%outer_sweeps  = prec%outer_sweeps
       if (allocated(prec%precv)) then
@@ -941,8 +834,8 @@ contains
           if (info == psb_success_) then
             pout%precv(lev)%base_a       => pout%precv(lev)%ac
             pout%precv(lev)%base_desc    => pout%precv(lev)%desc_ac
-            pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
-            pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
+            pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
+            pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
           end if
         end do
       end if
@@ -982,8 +875,8 @@ contains
       do i=2, size(b%precv)
         b%precv(i)%base_a    => b%precv(i)%ac
         b%precv(i)%base_desc => b%precv(i)%desc_ac
-        b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
-        b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
+        b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
+        b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
       end do
 
     else

amgprec/amg_c_rkr_solver.f90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!
+!    (C) Copyright 2020
+!
 !        Salvatore Filippone
 !        Pasqua D'Ambra
 !        Fabio Durastante
@@ -55,14 +52,14 @@
 !      2. Redistributions in binary form must reproduce the above copyright
 !         notice, this list of conditions, and the following disclaimer in the
 !         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!      3. The name of the MLD2P4 group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
 !
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
 !    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 !    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 !    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
@@ -73,16 +70,16 @@
 !
 !
 !
-! File: amg_c_krm_solver_mod.f90
+! File: amg_c_rkr_solver_mod.f90
 !
-! Module: amg_c_krm_solver_mod
+! Module: amg_c_rkr_solver_mod
 !
-module amg_c_krm_solver
+module amg_c_rkr_solver
 
   use amg_c_base_solver_mod
   use amg_c_prec_type
 
-  type, extends(amg_c_base_solver_type) :: amg_c_krm_solver_type
+  type, extends(amg_c_base_solver_type) :: amg_c_rkr_solver_type
     !
     logical               :: global
     character(len=16)     :: method, kprec, sub_solve
@@ -97,46 +94,46 @@ module amg_c_krm_solver
   contains
     !
     !
-    procedure, pass(sv) :: dump    => c_krm_solver_dmp
-    procedure, pass(sv) :: check   => c_krm_solver_check
-    procedure, pass(sv) :: clone   => c_krm_solver_clone
-    procedure, pass(sv) :: clone_settings   => c_krm_solver_clone_settings
-    procedure, pass(sv) :: cnv     => c_krm_solver_cnv
-    procedure, pass(sv) :: apply_v => amg_c_krm_solver_apply_vect
-    procedure, pass(sv) :: apply_a => amg_c_krm_solver_apply
-    procedure, pass(sv) :: clear_data  => c_krm_solver_clear_data
-    procedure, pass(sv) :: free    => c_krm_solver_free
-    procedure, pass(sv) :: cseti   => c_krm_solver_cseti
-    procedure, pass(sv) :: csetc   => c_krm_solver_csetc
-    procedure, pass(sv) :: csetr   => c_krm_solver_csetr
-    procedure, pass(sv) :: sizeof  => c_krm_solver_sizeof
-    procedure, pass(sv) :: get_nzeros => c_krm_solver_get_nzeros
-    !procedure, nopass   :: get_id  => c_krm_solver_get_id
-    procedure, pass(sv) :: is_global => c_krm_solver_is_global
-    procedure, nopass   :: is_iterative => c_krm_solver_is_iterative
+    procedure, pass(sv) :: dump    => c_rkr_solver_dmp
+    procedure, pass(sv) :: check   => c_rkr_solver_check
+    procedure, pass(sv) :: clone   => c_rkr_solver_clone
+    procedure, pass(sv) :: clone_settings   => c_rkr_solver_clone_settings
+    procedure, pass(sv) :: cnv     => c_rkr_solver_cnv
+    procedure, pass(sv) :: apply_v => amg_c_rkr_solver_apply_vect
+    procedure, pass(sv) :: apply_a => amg_c_rkr_solver_apply
+    procedure, pass(sv) :: clear_data  => c_rkr_solver_clear_data
+    procedure, pass(sv) :: free    => c_rkr_solver_free
+    procedure, pass(sv) :: cseti   => c_rkr_solver_cseti
+    procedure, pass(sv) :: csetc   => c_rkr_solver_csetc
+    procedure, pass(sv) :: csetr   => c_rkr_solver_csetr
+    procedure, pass(sv) :: sizeof  => c_rkr_solver_sizeof
+    procedure, pass(sv) :: get_nzeros => c_rkr_solver_get_nzeros
+    !procedure, nopass   :: get_id  => c_rkr_solver_get_id
+    procedure, pass(sv) :: is_global => c_rkr_solver_is_global
+    procedure, nopass   :: is_iterative => c_rkr_solver_is_iterative
 
 
     !
     ! These methods are specific for the new solver type
     ! and therefore need to be overridden
     !
-    procedure, pass(sv) :: descr   => c_krm_solver_descr
-    procedure, pass(sv) :: default => c_krm_solver_default
-    procedure, pass(sv) :: build   => amg_c_krm_solver_bld
-    procedure, nopass   :: get_fmt => c_krm_solver_get_fmt
-  end type amg_c_krm_solver_type
+    procedure, pass(sv) :: descr   => c_rkr_solver_descr
+    procedure, pass(sv) :: default => c_rkr_solver_default
+    procedure, pass(sv) :: build   => amg_c_rkr_solver_bld
+    procedure, nopass   :: get_fmt => c_rkr_solver_get_fmt
+  end type amg_c_rkr_solver_type
 
 
-  private ::  c_krm_solver_get_fmt, c_krm_solver_descr, c_krm_solver_default
+  private ::  c_rkr_solver_get_fmt, c_rkr_solver_descr, c_rkr_solver_default
 
   interface
-    subroutine amg_c_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
+    subroutine amg_c_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
          & trans,work,wv,info,init,initu)
-      import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
+      import :: psb_desc_type, amg_c_rkr_solver_type, psb_c_vect_type, psb_spk_, &
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
       implicit none
       type(psb_desc_type), intent(in)             :: desc_data
-      class(amg_c_krm_solver_type), intent(inout) :: sv
+      class(amg_c_rkr_solver_type), intent(inout) :: sv
       type(psb_c_vect_type),intent(inout)         :: x
       type(psb_c_vect_type),intent(inout)         :: y
       complex(psb_spk_),intent(in)                    :: alpha,beta
@@ -146,17 +143,17 @@ module amg_c_krm_solver
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init
       type(psb_c_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_c_krm_solver_apply_vect
+    end subroutine amg_c_rkr_solver_apply_vect
   end interface
 
   interface
-    subroutine amg_c_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
+    subroutine amg_c_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
          & trans,work,info,init,initu)
-      import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
+      import :: psb_desc_type, amg_c_rkr_solver_type, psb_c_vect_type, psb_spk_, &
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
       implicit none
       type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_c_krm_solver_type), intent(inout) :: sv
+      class(amg_c_rkr_solver_type), intent(inout) :: sv
       complex(psb_spk_),intent(inout)         :: x(:)
       complex(psb_spk_),intent(inout)         :: y(:)
       complex(psb_spk_),intent(in)            :: alpha,beta
@@ -165,24 +162,24 @@ module amg_c_krm_solver
       integer(psb_ipk_), intent(out)        :: info
       character, intent(in), optional       :: init
       complex(psb_spk_),intent(inout), optional :: initu(:)
-    end subroutine amg_c_krm_solver_apply
+    end subroutine amg_c_rkr_solver_apply
   end interface
 
   interface
-    subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
+    subroutine amg_c_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
+      import :: psb_desc_type, amg_c_rkr_solver_type, psb_c_vect_type, psb_spk_, &
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none
       type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
-      class(amg_c_krm_solver_type), intent(inout)         :: sv
+      class(amg_c_rkr_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info
       type(psb_cspmat_type), intent(in), target, optional :: b
       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
-    end subroutine amg_c_krm_solver_bld
+    end subroutine amg_c_rkr_solver_bld
   end interface
 
 
@@ -190,12 +187,12 @@ contains
 
   !
   !
-  subroutine c_krm_solver_default(sv)
+  subroutine c_rkr_solver_default(sv)
 
     Implicit None
 
     ! Arguments
-    class(amg_c_krm_solver_type), intent(inout) :: sv
+    class(amg_c_rkr_solver_type), intent(inout) :: sv
 
     sv%method     = 'bicgstab'
     sv%kprec      = 'bjac'
@@ -210,42 +207,42 @@ contains
     sv%global = .false.
 
     return
-  end subroutine c_krm_solver_default
+  end subroutine c_rkr_solver_default
 
-  function c_krm_solver_get_nzeros(sv) result(val)
+  function c_rkr_solver_get_nzeros(sv) result(val)
 
     implicit none
     ! Arguments
-    class(amg_c_krm_solver_type), intent(in) :: sv
+    class(amg_c_rkr_solver_type), intent(in) :: sv
     integer(psb_epk_) :: val
 
     val = sv%prec%get_nzeros()
 
     return
-  end function c_krm_solver_get_nzeros
+  end function c_rkr_solver_get_nzeros
 
-  function c_krm_solver_sizeof(sv) result(val)
+  function c_rkr_solver_sizeof(sv) result(val)
 
     implicit none
     ! Arguments
-    class(amg_c_krm_solver_type), intent(in) :: sv
+    class(amg_c_rkr_solver_type), intent(in) :: sv
     integer(psb_epk_) :: val
 
     val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
 
     return
-  end function c_krm_solver_sizeof
+  end function c_rkr_solver_sizeof
 
 
-  subroutine c_krm_solver_check(sv,info)
+  subroutine c_rkr_solver_check(sv,info)
 
     Implicit None
 
     ! Arguments
-    class(amg_c_krm_solver_type), intent(inout) :: sv
+    class(amg_c_rkr_solver_type), intent(inout) :: sv
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_) :: err_act
-    character(len=20) :: name='c_krm_solver_check'
+    character(len=20) :: name='c_rkr_solver_check'
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -259,36 +256,36 @@ contains
 9999 call psb_error_handler(err_act)
     return
 
-  end subroutine c_krm_solver_check
+  end subroutine c_rkr_solver_check
 
-  subroutine c_krm_solver_cseti(sv,what,val,info,idx)
+  subroutine c_rkr_solver_cseti(sv,what,val,info,idx)
 
     Implicit None
 
     ! Arguments
-    class(amg_c_krm_solver_type), intent(inout) :: sv
+    class(amg_c_rkr_solver_type), intent(inout) :: sv
     character(len=*), intent(in)                  :: what
     integer(psb_ipk_), intent(in)                 :: val
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_), intent(in), optional       :: idx
     integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='c_krm_solver_cseti'
+    character(len=20)  :: name='c_rkr_solver_cseti'
 
     info = psb_success_
     call psb_erractionsave(err_act)
 
     select case(psb_toupper(trim(what)))
-    case('KRM_IRST')
+    case('RKR_IRST')
       sv%irst = val
-    case('KRM_ISTOPC')
+    case('RKR_ISTOPC')
       sv%istopc = val
-    case('KRM_ITMAX')
+    case('RKR_ITMAX')
       sv%itmax = val
-    case('KRM_ITRACE')
+    case('RKR_ITRACE')
       sv%itrace = val
-    case('KRM_SUB_SOLVE')
+    case('RKR_SUB_SOLVE')
       sv%i_sub_solve = val
-    case('KRM_FILLIN')
+    case('RKR_FILLIN')
       sv%fillin = val
     case default
       call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
@@ -299,33 +296,33 @@ contains
 
 9999 call psb_error_handler(err_act)
     return
-  end subroutine c_krm_solver_cseti
+  end subroutine c_rkr_solver_cseti
 
-  subroutine c_krm_solver_csetc(sv,what,val,info,idx)
+  subroutine c_rkr_solver_csetc(sv,what,val,info,idx)
 
     Implicit None
 
     ! Arguments
-    class(amg_c_krm_solver_type), intent(inout) :: sv
+    class(amg_c_rkr_solver_type), intent(inout) :: sv
     character(len=*), intent(in)                  :: what
     character(len=*), intent(in)                  :: val
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_), intent(in), optional       :: idx
     integer(psb_ipk_)  :: err_act, ival
-    character(len=20)  :: name='c_krm_solver_csetc'
+    character(len=20)  :: name='c_rkr_solver_csetc'
 
     info = psb_success_
     call psb_erractionsave(err_act)
 
 
     select case(psb_toupper(trim(what)))
-    case('KRM_METHOD')
+    case('RKR_METHOD')
       sv%method = psb_toupper(trim(val))
-    case('KRM_KPREC')
+    case('RKR_KPREC')
       sv%kprec = psb_toupper(trim(val))
-    case('KRM_SUB_SOLVE')
+    case('RKR_SUB_SOLVE')
       sv%sub_solve = psb_toupper(trim(val))
-    case('KRM_GLOBAL')
+    case('RKR_GLOBAL')
       select case(psb_toupper(trim(val)))
       case('LOCAL','FALSE')
         sv%global = .false.
@@ -348,26 +345,26 @@ contains
 
 9999 call psb_error_handler(err_act)
     return
-  end subroutine c_krm_solver_csetc
+  end subroutine c_rkr_solver_csetc
 
-  subroutine c_krm_solver_csetr(sv,what,val,info,idx)
+  subroutine c_rkr_solver_csetr(sv,what,val,info,idx)
 
     Implicit None
 
     ! Arguments
-    class(amg_c_krm_solver_type), intent(inout) :: sv
+    class(amg_c_rkr_solver_type), intent(inout) :: sv
     character(len=*), intent(in)                  :: what
     real(psb_spk_), intent(in)                  :: val
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_), intent(in), optional       :: idx
     integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='c_krm_solver_csetr'
+    character(len=20)  :: name='c_rkr_solver_csetr'
 
     call psb_erractionsave(err_act)
     info = psb_success_
 
     select case(psb_toupper(what))
-    case('KRM_EPS')
+    case('RKR_EPS')
       sv%eps = val
     case default
       call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
@@ -378,18 +375,18 @@ contains
 
 9999 call psb_error_handler(err_act)
     return
-  end subroutine c_krm_solver_csetr
+  end subroutine c_rkr_solver_csetr
 
-  subroutine c_krm_solver_clear_data(sv,info)
+  subroutine c_rkr_solver_clear_data(sv,info)
     use psb_base_mod, only : psb_exit
     Implicit None
 
     ! Arguments
-    class(amg_c_krm_solver_type), intent(inout) :: sv
+    class(amg_c_rkr_solver_type), intent(inout) :: sv
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_) :: err_act
     type(psb_ctxt_type)  :: l_ctxt
-    character(len=20)  :: name='c_krm_solver_free'
+    character(len=20)  :: name='c_rkr_solver_free'
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -406,19 +403,19 @@ contains
     nullify(sv%a)
     call psb_erractionrestore(err_act)
     return
-  end subroutine c_krm_solver_clear_data
+  end subroutine c_rkr_solver_clear_data
 
 
-  subroutine c_krm_solver_free(sv,info)
+  subroutine c_rkr_solver_free(sv,info)
     use psb_base_mod, only : psb_exit
     Implicit None
 
     ! Arguments
-    class(amg_c_krm_solver_type), intent(inout) :: sv
+    class(amg_c_rkr_solver_type), intent(inout) :: sv
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_)  :: err_act
     type(psb_ctxt_type) :: l_ctxt
-    character(len=20)  :: name='c_krm_solver_free'
+    character(len=20)  :: name='c_rkr_solver_free'
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -427,31 +424,29 @@ contains
 
     call psb_erractionrestore(err_act)
     return
-  end subroutine c_krm_solver_free
+  end subroutine c_rkr_solver_free
 
-  function c_krm_solver_get_fmt() result(val)
+  function c_rkr_solver_get_fmt() result(val)
     implicit none
     character(len=32)  :: val
 
-    val = "KRM solver"
-  end function c_krm_solver_get_fmt
+    val = "RKR solver"
+  end function c_rkr_solver_get_fmt
 
-  subroutine c_krm_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine c_rkr_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
-    class(amg_c_krm_solver_type), intent(in) :: sv
+    class(amg_c_rkr_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional              :: coarse
-    character(len=*), intent(in), optional  :: prefix
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_c_krm_solver_descr'
+    character(len=20), parameter :: name='amg_c_rkr_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -460,33 +455,34 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
     if (sv%global) then
-      write(iout_,*) trim(prefix_), '  Krylov solver (global)'
+      write(iout_,*) '  Recursive Krylov solver (global)'
     else
-      write(iout_,*) trim(prefix_), '  Krylov solver (local) '
+      write(iout_,*) '  Recursive Krylov solver (local) '
     end if
-    write(iout_,*) trim(prefix_), '    method: ',sv%method
-    write(iout_,*) trim(prefix_), '     kprec: ',sv%kprec
-    call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
-    write(iout_,*) trim(prefix_), '     itmax: ',sv%itmax
-    write(iout_,*) trim(prefix_), '       eps: ',sv%eps
+    write(iout_,*) '    method: ',sv%method
+    write(iout_,*) '     kprec: ',sv%kprec
+    if (sv%i_sub_solve > 0) then
+      write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
+    else
+      write(iout_,*) ' sub_solve: ',sv%sub_solve
+    end if
+    write(iout_,*) '     itmax: ',sv%itmax
+    write(iout_,*) '       eps: ',sv%eps
+    write(iout_,*) '    fillin: ',sv%fillin
+
 
     call psb_erractionrestore(err_act)
     return
 
 9999 call psb_error_handler(err_act)
     return
-  end subroutine c_krm_solver_descr
+  end subroutine c_rkr_solver_descr
 
-  subroutine c_krm_solver_cnv(sv,info,amold,vmold,imold)
+  subroutine c_rkr_solver_cnv(sv,info,amold,vmold,imold)
     implicit none
-    class(amg_c_krm_solver_type), intent(inout)         :: sv
+    class(amg_c_rkr_solver_type), intent(inout)         :: sv
     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
@@ -494,13 +490,13 @@ contains
 
     call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
 
-  end subroutine c_krm_solver_cnv
+  end subroutine c_rkr_solver_cnv
 
-  subroutine c_krm_solver_clone(sv,svout,info)
+  subroutine c_rkr_solver_clone(sv,svout,info)
     Implicit None
 
     ! Arguments
-    class(amg_c_krm_solver_type), intent(inout)               :: sv
+    class(amg_c_rkr_solver_type), intent(inout)               :: sv
     class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
     integer(psb_ipk_), intent(out)              :: info
 
@@ -509,7 +505,7 @@ contains
     call svout%free(info)
     allocate(svout,stat=info,mold=sv)
     select type(so=>svout)
-    class is(amg_c_krm_solver_type)
+    class is(amg_c_rkr_solver_type)
       so%method = sv%method
       so%kprec  = sv%kprec
       so%sub_solve = sv%sub_solve
@@ -528,21 +524,21 @@ contains
       info = psb_err_internal_error_
     end select
 
-  end subroutine c_krm_solver_clone
+  end subroutine c_rkr_solver_clone
 
 
-  subroutine c_krm_solver_clone_settings(sv,svout,info)
+  subroutine c_rkr_solver_clone_settings(sv,svout,info)
     Implicit None
 
     ! Arguments
-    class(amg_c_krm_solver_type), intent(inout)               :: sv
+    class(amg_c_rkr_solver_type), intent(inout)               :: sv
     class(amg_c_base_solver_type), intent(inout) :: svout
     integer(psb_ipk_), intent(out)              :: info
 
     info = psb_success_
 
     select type(so=>svout)
-    class is(amg_c_krm_solver_type)
+    class is(amg_c_rkr_solver_type)
       so%method = sv%method
       so%kprec  = sv%kprec
       so%sub_solve = sv%sub_solve
@@ -558,11 +554,11 @@ contains
       info = psb_err_internal_error_
     end select
 
-  end subroutine c_krm_solver_clone_settings
+  end subroutine c_rkr_solver_clone_settings
 
-  subroutine c_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
+  subroutine c_rkr_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
     implicit none
-    class(amg_c_krm_solver_type), intent(in) :: sv
+    class(amg_c_rkr_solver_type), intent(in) :: sv
     type(psb_desc_type), intent(in)             :: desc
     integer(psb_ipk_), intent(in)              :: level
     integer(psb_ipk_), intent(out)             :: info
@@ -572,23 +568,23 @@ contains
 
     call sv%prec%dump(info,prefix=prefix,head=head)
 
-  end subroutine c_krm_solver_dmp
+  end subroutine c_rkr_solver_dmp
   !
-  ! Notify whether KRM is used as a global solver
+  ! Notify whether RKR is used as a global solver
   !
-  function c_krm_solver_is_global(sv) result(val)
+  function c_rkr_solver_is_global(sv) result(val)
     implicit none
-    class(amg_c_krm_solver_type), intent(in) :: sv
+    class(amg_c_rkr_solver_type), intent(in) :: sv
     logical  :: val
 
     val = (sv%global)
-  end function c_krm_solver_is_global
+  end function c_rkr_solver_is_global
   !
-  function c_krm_solver_is_iterative() result(val)
+  function c_rkr_solver_is_iterative() result(val)
     implicit none
     logical  :: val
 
     val = .true.
-  end function c_krm_solver_is_iterative
+  end function c_rkr_solver_is_iterative
 
-end module amg_c_krm_solver
+end module amg_c_rkr_solver

amgprec/amg_c_slu_solver.F90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -385,22 +385,20 @@ contains
   
   end subroutine c_slu_solver_finalize
 
-  subroutine c_slu_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine c_slu_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_c_slu_solver_type), intent(in) :: sv
-    integer, intent(out)                       :: info
-    integer, intent(in), optional              :: iout
-    logical, intent(in), optional              :: coarse
-    character(len=*), intent(in), optional     :: prefix
+    integer, intent(out)                     :: info
+    integer, intent(in), optional            :: iout
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer      :: err_act
     character(len=20), parameter :: name='amg_c_slu_solver_descr'
     integer :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -409,13 +407,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
     
-    write(iout_,*) trim(prefix_), '  SuperLU Sparse Factorization Solver. '
+    write(iout_,*) '  SuperLU Sparse Factorization Solver. '
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_c_symdec_aggregator_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -88,25 +88,16 @@ contains
     val = "Symmetric Decoupled aggregation"
   end function amg_c_symdec_aggregator_fmt
   
-  subroutine  amg_c_symdec_aggregator_descr(ag,parms,iout,info,prefix)
+  subroutine  amg_c_symdec_aggregator_descr(ag,parms,iout,info)
     implicit none 
     class(amg_c_symdec_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
-    character(len=*), intent(in), optional  :: prefix
 
-    character(1024)    :: prefix_
-
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
-    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info,prefix=prefix)
+    write(iout,*) 'Decoupled Aggregator locally-symmetrized'
+    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info)
     
     return
   end subroutine amg_c_symdec_aggregator_descr

amgprec/amg_d_ainv_solver.F90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -58,13 +55,13 @@ module amg_d_ainv_solver
     procedure, pass(sv) :: check   => amg_d_ainv_solver_check
     procedure, pass(sv) :: build   => amg_d_ainv_solver_bld
     procedure, pass(sv) :: clone   => amg_d_ainv_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_d_ainv_solver_clone_settings
     procedure, pass(sv) :: cseti   => amg_d_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_d_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_d_ainv_solver_csetr
-!!$    procedure, pass(sv) :: seti    => amg_d_ainv_solver_seti
-!!$    procedure, pass(sv) :: setc    => amg_d_ainv_solver_setc
-!!$    procedure, pass(sv) :: setr    => amg_d_ainv_solver_setr
+    procedure, pass(sv) :: seti    => amg_d_ainv_solver_seti
+    procedure, pass(sv) :: setc    => amg_d_ainv_solver_setc
+    procedure, pass(sv) :: setr    => amg_d_ainv_solver_setr
+    generic, public :: set => seti, setr, setc
     procedure, pass(sv) :: descr   => amg_d_ainv_solver_descr
     procedure, pass(sv) :: default => d_ainv_solver_default
     procedure, nopass   :: stringval  => d_ainv_stringval
@@ -86,16 +83,6 @@ module amg_d_ainv_solver
     end subroutine amg_d_ainv_solver_clone
   end interface
 
-  interface
-    subroutine amg_d_ainv_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
-       & amg_d_base_solver_type, psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
-      Implicit None
-      class(amg_d_ainv_solver_type), intent(inout)              :: sv
-      class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_d_ainv_solver_clone_settings
-  end interface
 
   interface
     subroutine amg_d_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
@@ -172,44 +159,44 @@ module amg_d_ainv_solver
     end subroutine amg_d_ainv_solver_csetr
   end interface
 
-!!$  interface
-!!$    subroutine amg_d_ainv_solver_setc(sv,what,val,info)
-!!$      import :: amg_d_ainv_solver_type, psb_ipk_
-!!$      Implicit none
-!!$      ! Arguments
-!!$      class(amg_d_ainv_solver_type), intent(inout) :: sv
-!!$      integer(psb_ipk_), intent(in)                :: what
-!!$      character(len=*), intent(in)                 :: val
-!!$      integer(psb_ipk_), intent(out)               :: info
-!!$    end subroutine amg_d_ainv_solver_setc
-!!$  end interface
-!!$
-!!$  interface
-!!$    subroutine amg_d_ainv_solver_seti(sv,what,val,info)
-!!$      import :: amg_d_ainv_solver_type, psb_ipk_
-!!$      Implicit none
-!!$      ! Arguments
-!!$      class(amg_d_ainv_solver_type), intent(inout) :: sv
-!!$      integer(psb_ipk_), intent(in)                :: what
-!!$      integer(psb_ipk_), intent(in)                :: val
-!!$      integer(psb_ipk_), intent(out)               :: info
-!!$    end subroutine amg_d_ainv_solver_seti
-!!$  end interface
-!!$
-!!$  interface
-!!$    subroutine amg_d_ainv_solver_setr(sv,what,val,info)
-!!$      import :: amg_d_ainv_solver_type, psb_ipk_, psb_dpk_
-!!$      Implicit none
-!!$      ! Arguments
-!!$      class(amg_d_ainv_solver_type), intent(inout) :: sv
-!!$      integer(psb_ipk_), intent(in)                :: what
-!!$      real(psb_dpk_), intent(in)                   :: val
-!!$      integer(psb_ipk_), intent(out)               :: info
-!!$    end subroutine amg_d_ainv_solver_setr
-!!$  end interface
+  interface
+    subroutine amg_d_ainv_solver_setc(sv,what,val,info)
+      import :: amg_d_ainv_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_d_ainv_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      character(len=*), intent(in)                 :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_d_ainv_solver_setc
+  end interface
 
   interface
-    subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse,prefix)
+    subroutine amg_d_ainv_solver_seti(sv,what,val,info)
+      import :: amg_d_ainv_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_d_ainv_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      integer(psb_ipk_), intent(in)                :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_d_ainv_solver_seti
+  end interface
+
+  interface
+    subroutine amg_d_ainv_solver_setr(sv,what,val,info)
+      import :: amg_d_ainv_solver_type, psb_ipk_, psb_dpk_
+      Implicit none
+      ! Arguments
+      class(amg_d_ainv_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      real(psb_dpk_), intent(in)                   :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_d_ainv_solver_setr
+  end interface
+
+  interface
+    subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse)
       import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
 
       Implicit None
@@ -219,7 +206,7 @@ module amg_d_ainv_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-      character(len=*), intent(in), optional  :: prefix
+
     end subroutine amg_d_ainv_solver_descr
   end interface
 

amgprec/amg_d_as_smoother.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -396,23 +396,21 @@ contains
   end subroutine d_as_smoother_default
 
 
-  subroutine d_as_smoother_descr(sm,info,iout,coarse,prefix)
+  subroutine d_as_smoother_descr(sm,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_d_as_smoother_type), intent(in) :: sm
-    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional              :: coarse
-      character(len=*), intent(in), optional   :: prefix
+    integer(psb_ipk_), intent(out)                      :: info
+    integer(psb_ipk_), intent(in), optional             :: iout
+    logical, intent(in), optional             :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_d_as_smoother_descr'
     integer(psb_ipk_) :: iout_
     logical      :: coarse_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -426,21 +424,16 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
     if (.not.coarse_) then 
-      write(iout_,*) trim(prefix_), '  Additive Schwarz with  ',&
+      write(iout_,*) '  Additive Schwarz with  ',&
            &  sm%novr, ' overlap layers.'
-      write(iout_,*) trim(prefix_), '  Restrictor:  ',restrict_names(sm%restr)
-      write(iout_,*) trim(prefix_), '  Prolongator: ',prolong_names(sm%prol)
-      write(iout_,*) trim(prefix_), '  Local solver:'
+      write(iout_,*) '  Restrictor:  ',restrict_names(sm%restr)
+      write(iout_,*) '  Prolongator: ',prolong_names(sm%prol)
+      write(iout_,*) '  Local solver:'
     endif
     if (allocated(sm%sv)) then 
-      call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
+      call sm%sv%descr(info,iout_,coarse=coarse)
     end if
 
     call psb_erractionrestore(err_act)

amgprec/amg_d_base_aggregator_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -126,7 +126,7 @@ module amg_d_base_aggregator_mod
            & psb_d_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(inout)         :: desc_a
+      type(psb_desc_type), intent(in)            :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_dml_parms), intent(inout)         :: parms 
       type(psb_d_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -144,7 +144,7 @@ module amg_d_base_aggregator_mod
            & psb_d_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(inout)         :: desc_a
+      type(psb_desc_type), intent(in)            :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_dml_parms), intent(inout)         :: parms 
       type(psb_d_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -275,22 +275,15 @@ contains
     val = .false.
   end function amg_d_base_aggregator_xt_desc
 
-  subroutine  amg_d_base_aggregator_descr(ag,parms,iout,info,prefix)
+  subroutine  amg_d_base_aggregator_descr(ag,parms,iout,info)
     implicit none 
     class(amg_d_base_aggregator_type), intent(in) :: ag
     type(amg_dml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
-    character(len=*), intent(in), optional  :: prefix
-    character(1024)    :: prefix_
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
-    write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info,prefix=prefix)
+    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info)
     
     return
   end subroutine amg_d_base_aggregator_descr

amgprec/amg_d_base_ainv_mod.f90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions

amgprec/amg_d_base_smoother_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -272,7 +272,7 @@ module amg_d_base_smoother_mod
   end interface
   
   interface 
-    subroutine amg_d_base_smoother_descr(sm,info,iout,coarse,prefix)
+    subroutine amg_d_base_smoother_descr(sm,info,iout,coarse)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
            & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
            & amg_d_base_smoother_type, psb_ipk_
@@ -281,7 +281,6 @@ module amg_d_base_smoother_mod
       integer(psb_ipk_), intent(out)                :: info
       integer(psb_ipk_), intent(in), optional       :: iout
       logical, intent(in), optional                 :: coarse
-      character(len=*), intent(in), optional        :: prefix
     end subroutine amg_d_base_smoother_descr
   end interface
   

amgprec/amg_d_base_solver_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -270,7 +270,7 @@ module amg_d_base_solver_mod
   end interface
   
   interface
-    subroutine amg_d_base_solver_descr(sv,info,iout,coarse,prefix)
+    subroutine amg_d_base_solver_descr(sv,info,iout,coarse)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
            & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
            & amg_d_base_solver_type, psb_ipk_
@@ -281,7 +281,7 @@ module amg_d_base_solver_mod
       integer(psb_ipk_), intent(out)              :: info
       integer(psb_ipk_), intent(in), optional     :: iout
       logical, intent(in), optional               :: coarse
-      character(len=*), intent(in), optional      :: prefix
+
     end subroutine amg_d_base_solver_descr
   end interface 
   

amgprec/amg_d_dec_aggregator_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -184,23 +184,16 @@ contains
     val = "Decoupled aggregation"
   end function amg_d_dec_aggregator_fmt
   
-  subroutine  amg_d_dec_aggregator_descr(ag,parms,iout,info,prefix)
+  subroutine  amg_d_dec_aggregator_descr(ag,parms,iout,info)
     implicit none 
     class(amg_d_dec_aggregator_type), intent(in) :: ag
     type(amg_dml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
-    character(len=*), intent(in), optional  :: prefix
-    character(1024)    :: prefix_
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
-    write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
-    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info,prefix=prefix)
+    write(iout,*) 'Decoupled Aggregator'
+    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info)
     
     return
   end subroutine amg_d_dec_aggregator_descr

amgprec/amg_d_diag_solver.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -219,7 +219,7 @@ contains
 
   end subroutine d_diag_solver_free
 
-  subroutine d_diag_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine d_diag_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
@@ -228,13 +228,11 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
-    character(len=*), intent(in), optional      :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_d_diag_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -242,13 +240,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    write(iout_,*) trim(prefix_), '  Diagonal local solver '
+    
+    write(iout_,*) '  Diagonal local solver '
 
     return
 
@@ -359,7 +352,7 @@ module amg_d_l1_diag_solver
   
 contains
 
-  subroutine d_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine d_l1_diag_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
@@ -368,13 +361,11 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
-    character(len=*), intent(in), optional  :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_d_l1_diag_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -382,13 +373,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    write(iout_,*) trim(prefix_), '  L1 Diagonal solver '
+    
+    write(iout_,*) '  L1 Diagonal solver '
 
     return
 

amgprec/amg_d_gs_solver.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -433,22 +433,20 @@ contains
     return
   end subroutine d_gs_solver_free
 
-  subroutine d_gs_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine d_gs_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_d_gs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
+    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(in), optional    :: iout
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_d_gs_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -457,17 +455,12 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     
@@ -533,22 +526,20 @@ contains
     val = .true.
   end function d_gs_solver_is_iterative
     
-  subroutine d_bwgs_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine d_bwgs_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_d_bwgs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional               :: coarse
-    character(len=*), intent(in), optional      :: prefix
+    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(in), optional    :: iout
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_d_bwgs_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -557,17 +548,12 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     

amgprec/amg_d_hybrid_aggregator_mod.F90

@@ -2,7 +2,7 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
 !    (C) Copyright 2020 
 !  

amgprec/amg_d_id_solver.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -157,7 +157,7 @@ contains
     return
   end subroutine d_id_solver_free
 
-  subroutine d_id_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine d_id_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
@@ -165,14 +165,12 @@ contains
     class(amg_d_id_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)            :: info
     integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_d_id_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -180,13 +178,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
     
-    write(iout_,*) trim(prefix_), '  Identity local solver '
+    write(iout_,*) '  Identity local solver '
 
     return
 

amgprec/amg_d_ilu_fact_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   

amgprec/amg_d_ilu_solver.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -234,7 +234,7 @@ contains
     ! Arguments
     class(amg_d_ilu_solver_type), intent(inout) :: sv
 
-    sv%fact_type = amg_ilu_n_
+    sv%fact_type = psb_ilu_n_
     sv%fill_in   = 0
     sv%thresh    = dzero
 
@@ -255,13 +255,13 @@ contains
     info = psb_success_
 
     call amg_check_def(sv%fact_type,&
-         & 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
+         & 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
 
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
+    case(psb_ilu_n_,psb_milu_n_)      
       call amg_check_def(sv%fill_in,&
            & 'Level',izero,is_int_non_negative)
-    case(amg_ilu_t_)                 
+    case(psb_ilu_t_)                 
       call amg_check_def(sv%thresh,&
            & 'Eps',dzero,is_legal_d_fact_thrs)
     end select
@@ -406,7 +406,7 @@ contains
     return
   end subroutine d_ilu_solver_free
 
-  subroutine d_ilu_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine d_ilu_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
@@ -414,14 +414,12 @@ contains
     class(amg_d_ilu_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional              :: coarse
-    character(len=*), intent(in), optional  :: prefix
-      
+    logical, intent(in), optional       :: coarse
+
     ! Local variables
     integer(psb_ipk_) :: err_act
     character(len=20), parameter :: name='amg_d_ilu_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -430,20 +428,15 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
-    write(iout_,*) trim(prefix_), '  Incomplete factorization solver: ',&
+    write(iout_,*) '  Incomplete factorization solver: ',&
          &  amg_fact_names(sv%fact_type)
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
-      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-    case(amg_ilu_t_)         
-      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-      write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
+    case(psb_ilu_n_,psb_milu_n_)      
+      write(iout_,*) '  Fill level:',sv%fill_in
+    case(psb_ilu_t_)         
+      write(iout_,*) '  Fill level:',sv%fill_in
+      write(iout_,*) '  Fill threshold :',sv%thresh
     end select
 
     call psb_erractionrestore(err_act)
@@ -496,7 +489,7 @@ contains
     implicit none 
     integer(psb_ipk_)  :: val
     
-    val = amg_ilu_n_
+    val = psb_ilu_n_
   end function d_ilu_solver_get_id
 
   function d_ilu_solver_get_wrksize() result(val)

amgprec/amg_d_inner_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -39,7 +39,7 @@
 !
 ! Module: amg_inner_mod
 !
-!  This module defines the interfaces to inner AMG4PSBLAS routines.
+!  This module defines the interfaces to inner MLD2P4 routines.
 !  The interfaces  of the user level routines are defined in amg_prec_mod.f90.
 !
 module amg_d_inner_mod

amgprec/amg_d_invk_solver.f90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -52,9 +49,10 @@ module amg_d_invk_solver
   contains
     procedure, pass(sv) :: check   => amg_d_invk_solver_check
     procedure, pass(sv) :: clone   => amg_d_invk_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_d_invk_solver_clone_settings
     procedure, pass(sv) :: build   => amg_d_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_d_invk_solver_cseti
+    procedure, pass(sv) :: seti    => amg_d_invk_solver_seti
+    generic, public     :: set     => seti
     procedure, pass(sv) :: descr   => amg_d_invk_solver_descr
     procedure, pass(sv) :: default => d_invk_solver_default
   end type amg_d_invk_solver_type
@@ -74,17 +72,6 @@ module amg_d_invk_solver
     end subroutine amg_d_invk_solver_clone
   end interface
 
-  interface
-    subroutine amg_d_invk_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
-       & amg_d_base_solver_type, psb_dpk_, amg_d_invk_solver_type, psb_ipk_
-      Implicit None
-      class(amg_d_invk_solver_type), intent(inout)              :: sv
-      class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_d_invk_solver_clone_settings
-  end interface
-
   interface
     subroutine amg_d_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
@@ -135,7 +122,7 @@ module amg_d_invk_solver
   end interface
 
   interface
-    subroutine amg_d_invk_solver_descr(sv,info,iout,coarse,prefix)
+    subroutine amg_d_invk_solver_descr(sv,info,iout,coarse)
       import :: psb_dpk_, amg_d_invk_solver_type, psb_ipk_
 
       Implicit None
@@ -145,10 +132,22 @@ module amg_d_invk_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-      character(len=*), intent(in), optional  :: prefix
+
     end subroutine amg_d_invk_solver_descr
   end interface
 
+  interface
+    subroutine amg_d_invk_solver_seti(sv,what,val,info)
+      import :: amg_d_invk_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_d_invk_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      integer(psb_ipk_), intent(in)                :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_d_invk_solver_seti
+  end interface
+
 contains
 
   subroutine d_invk_solver_default(sv)

amgprec/amg_d_invt_solver.f90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -52,10 +49,12 @@ module amg_d_invt_solver
   contains
     procedure, pass(sv) :: check   => amg_d_invt_solver_check
     procedure, pass(sv) :: clone   => amg_d_invt_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_d_invt_solver_clone_settings
     procedure, pass(sv) :: build   => amg_d_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_d_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_d_invt_solver_csetr
+    procedure, pass(sv) :: seti    => amg_d_invt_solver_seti
+    procedure, pass(sv) :: setr    => amg_d_invt_solver_setr
+    generic, public     :: set     => seti, setr
     procedure, pass(sv) :: descr   => amg_d_invt_solver_descr
     procedure, pass(sv) :: default => d_invt_solver_default
   end type amg_d_invt_solver_type
@@ -74,17 +73,6 @@ module amg_d_invt_solver
     end subroutine amg_d_invt_solver_clone
   end interface
 
-  interface
-    subroutine amg_d_invt_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
-       & amg_d_base_solver_type, psb_dpk_, amg_d_invt_solver_type, psb_ipk_
-      Implicit None
-      class(amg_d_invt_solver_type), intent(inout)              :: sv
-      class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_d_invt_solver_clone_settings
-  end interface
-
   interface
     subroutine amg_d_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
@@ -146,21 +134,44 @@ module amg_d_invt_solver
   end interface
 
   interface
-    subroutine amg_d_invt_solver_descr(sv,info,iout,coarse,prefix)
+    subroutine amg_d_invt_solver_descr(sv,info,iout,coarse)
       import :: psb_dpk_, amg_d_invt_solver_type, psb_ipk_
 
       Implicit None
 
       ! Arguments
       class(amg_d_invt_solver_type), intent(in) :: sv
-      integer(psb_ipk_), intent(out)              :: info
-      integer(psb_ipk_), intent(in), optional     :: iout
-      logical, intent(in), optional               :: coarse
-      character(len=*), intent(in), optional      :: prefix
+      integer(psb_ipk_), intent(out)            :: info
+      integer(psb_ipk_), intent(in), optional   :: iout
+      logical, intent(in), optional             :: coarse
 
     end subroutine amg_d_invt_solver_descr
   end interface
 
+  interface
+    subroutine amg_d_invt_solver_setr(sv,what,val,info)
+      import :: amg_d_invt_solver_type, psb_dpk_, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_d_invt_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      real(psb_dpk_), intent(in)                   :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_d_invt_solver_setr
+  end interface
+
+  interface
+    subroutine amg_d_invt_solver_seti(sv,what,val,info)
+      import :: amg_d_invt_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_d_invt_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      integer(psb_ipk_), intent(in)                :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine
+  end interface
+
 contains
 
   subroutine d_invt_solver_default(sv)

amgprec/amg_d_jac_smoother.f90

@@ -2,9 +2,9 @@
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !
-!    (C) Copyright 2021
+!    (C) Copyright 2020
 !
 !        Salvatore Filippone
 !        Pasqua D'Ambra
@@ -219,13 +219,12 @@ module amg_d_jac_smoother
   end interface
 
   interface
-    subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse,prefix)
+    subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse)
       import :: amg_d_jac_smoother_type, psb_ipk_
       class(amg_d_jac_smoother_type), intent(in) :: sm
       integer(psb_ipk_), intent(out)               :: info
       integer(psb_ipk_), intent(in), optional      :: iout
-      logical, intent(in), optional                :: coarse
-      character(len=*), intent(in), optional       :: prefix
+      logical, intent(in), optional              :: coarse
     end subroutine amg_d_jac_smoother_descr
   end interface
 
@@ -314,13 +313,12 @@ module amg_d_jac_smoother
   end interface
 
   interface
-    subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
+    subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse)
       import :: amg_d_l1_jac_smoother_type, psb_ipk_
       class(amg_d_l1_jac_smoother_type), intent(in) :: sm
-      integer(psb_ipk_), intent(out)                  :: info
-      integer(psb_ipk_), intent(in), optional         :: iout
-      logical, intent(in), optional                   :: coarse
-      character(len=*), intent(in), optional          :: prefix
+      integer(psb_ipk_), intent(out)               :: info
+      integer(psb_ipk_), intent(in), optional      :: iout
+      logical, intent(in), optional              :: coarse
     end subroutine amg_d_l1_jac_smoother_descr
   end interface
 

amgprec/amg_d_jac_solver.f90

@@ -1,585 +0,0 @@
-!  
-!   
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!   
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
-!
-!
-! File: amg_d_jac_solver_mod.f90
-!
-! Module: amg_d_jac_solver_mod
-!
-!  This module defines: 
-!  - the amg_d_jac_solver_type data structure containing the ingredients
-!    for a local Jacobi  iteration. The iterations are local to a process
-!    (they operate on the block diagonal).
-!    
-!
-module amg_d_jac_solver
-
-  use amg_d_base_solver_mod
-
-  type, extends(amg_d_base_solver_type) :: amg_d_jac_solver_type
-    type(psb_dspmat_type)      :: a
-    type(psb_d_vect_type), allocatable :: dv
-    real(psb_dpk_), allocatable        :: d(:)
-    integer(psb_ipk_)          :: sweeps
-    real(psb_dpk_)             :: eps
-  contains
-    procedure, pass(sv) :: dump    => amg_d_jac_solver_dmp
-    procedure, pass(sv) :: check   => d_jac_solver_check
-    procedure, pass(sv) :: clone   => amg_d_jac_solver_clone
-    procedure, pass(sv) :: clone_settings => amg_d_jac_solver_clone_settings
-    procedure, pass(sv) :: clear_data     => amg_d_jac_solver_clear_data
-    procedure, pass(sv) :: build   => amg_d_jac_solver_bld
-    procedure, pass(sv) :: cnv     => amg_d_jac_solver_cnv
-    procedure, pass(sv) :: apply_v => amg_d_jac_solver_apply_vect
-    procedure, pass(sv) :: apply_a => amg_d_jac_solver_apply
-    procedure, pass(sv) :: free    => d_jac_solver_free
-    procedure, pass(sv) :: cseti   => d_jac_solver_cseti
-    procedure, pass(sv) :: csetc   => d_jac_solver_csetc
-    procedure, pass(sv) :: csetr   => d_jac_solver_csetr
-    procedure, pass(sv) :: descr   => d_jac_solver_descr
-    procedure, pass(sv) :: default => d_jac_solver_default
-    procedure, pass(sv) :: sizeof  => d_jac_solver_sizeof
-    procedure, pass(sv) :: get_nzeros => d_jac_solver_get_nzeros
-    procedure, nopass   :: get_wrksz  => d_jac_solver_get_wrksize
-    procedure, nopass   :: get_fmt    => d_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => d_jac_solver_get_id
-    procedure, nopass   :: is_iterative => d_jac_solver_is_iterative
-  end type amg_d_jac_solver_type
-
-  type, extends(amg_d_jac_solver_type) :: amg_d_l1_jac_solver_type
-  contains
-    procedure, pass(sv) :: build   => amg_d_l1_jac_solver_bld
-    procedure, pass(sv) :: descr   => d_l1_jac_solver_descr
-    procedure, nopass   :: get_fmt    => d_l1_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => d_l1_jac_solver_get_id
-  end type amg_d_l1_jac_solver_type
-
-
-  private :: d_jac_solver_bld, d_jac_solver_apply, &
-       &  d_jac_solver_free,   &
-       &  d_jac_solver_descr,  d_jac_solver_sizeof, &
-       &  d_jac_solver_default, d_jac_solver_dmp, &
-       &  d_jac_solver_apply_vect, d_jac_solver_get_nzeros, &
-       &  d_jac_solver_get_fmt, d_jac_solver_check,&
-       &  d_jac_solver_is_iterative, &
-       &  d_jac_solver_get_id, d_jac_solver_get_wrksize
-
-  interface 
-    subroutine amg_d_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,work,wv,info,init,initu)
-      import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)             :: desc_data
-      class(amg_d_jac_solver_type), intent(inout) :: sv
-      type(psb_d_vect_type),intent(inout)         :: x
-      type(psb_d_vect_type),intent(inout)         :: y
-      real(psb_dpk_),intent(in)                    :: alpha,beta
-      character(len=1),intent(in)                   :: trans
-      real(psb_dpk_),target, intent(inout)         :: work(:)
-      type(psb_d_vect_type),intent(inout)         :: wv(:)
-      integer(psb_ipk_), intent(out)                :: info
-      character, intent(in), optional                :: init
-      type(psb_d_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_d_jac_solver_apply_vect
-  end interface
-
-  interface 
-    subroutine amg_d_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
-      import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_d_jac_solver_type), intent(inout) :: sv
-      real(psb_dpk_),intent(inout)         :: x(:)
-      real(psb_dpk_),intent(inout)         :: y(:)
-      real(psb_dpk_),intent(in)            :: alpha,beta
-      character(len=1),intent(in)           :: trans
-      real(psb_dpk_),target, intent(inout) :: work(:)
-      integer(psb_ipk_), intent(out)        :: info
-      character, intent(in), optional       :: init
-      real(psb_dpk_),intent(inout), optional :: initu(:)
-    end subroutine amg_d_jac_solver_apply
-  end interface
-
-  interface 
-    subroutine amg_d_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_dspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_d_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_dspmat_type), intent(in), target, optional :: b
-      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 amg_d_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_d_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_d_l1_jac_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_dspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_d_l1_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_dspmat_type), intent(in), target, optional :: b
-      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 amg_d_l1_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_d_jac_solver_cnv(sv,info,amold,vmold,imold)
-      import :: amg_d_jac_solver_type, psb_dpk_, &
-           & psb_d_base_sparse_mat, psb_d_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      class(amg_d_jac_solver_type), intent(inout)         :: sv
-      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 amg_d_jac_solver_cnv
-  end interface
-  
-  interface 
-    subroutine amg_d_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
-      import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
-           & psb_ipk_
-      implicit none 
-      class(amg_d_jac_solver_type), intent(in) :: sv
-      type(psb_desc_type), intent(in)             :: desc
-      integer(psb_ipk_), intent(in)              :: level
-      integer(psb_ipk_), intent(out)             :: info
-      character(len=*), intent(in), optional     :: prefix, head
-      logical, optional, intent(in)              :: solver, global_num
-    end subroutine amg_d_jac_solver_dmp
-  end interface
-  
-  interface
-    subroutine amg_d_jac_solver_clone(sv,svout,info)
-      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
-           & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
-           & amg_d_base_solver_type, amg_d_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_d_jac_solver_type), intent(inout)               :: sv
-      class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)              :: info
-    end subroutine amg_d_jac_solver_clone
-  end interface
-  
-!!$  interface
-!!$    subroutine amg_d_l1_jac_solver_clone(sv,svout,info)
-!!$      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
-!!$           & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
-!!$           & amg_d_base_solver_type, amg_d_l1_jac_solver_type, psb_ipk_
-!!$      Implicit None
-!!$      
-!!$      ! Arguments
-!!$      class(amg_d_l1_jac_solver_type), intent(inout)               :: sv
-!!$      class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
-!!$      integer(psb_ipk_), intent(out)              :: info
-!!$    end subroutine amg_d_l1_jac_solver_clone
-!!$  end interface
-
-  interface
-    subroutine amg_d_jac_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
-           & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
-           & amg_d_base_solver_type, amg_d_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_d_jac_solver_type), intent(inout) :: sv
-      class(amg_d_base_solver_type), intent(inout) :: svout
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_d_jac_solver_clone_settings
-  end interface
-
-  interface
-    subroutine amg_d_jac_solver_clear_data(sv,info)
-      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
-           & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
-           & amg_d_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_d_jac_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(out)                 :: info
-    end subroutine amg_d_jac_solver_clear_data
-  end interface
-
-contains
-
-  subroutine d_jac_solver_default(sv)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(inout) :: sv
-
-    sv%sweeps = ione
-    sv%eps    = dzero
-    
-    return
-  end subroutine d_jac_solver_default
-
-  subroutine d_jac_solver_check(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20) :: name='d_jac_solver_check'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call amg_check_def(sv%sweeps,&
-         & 'Jacobi sweeps',ione,is_int_positive)
-
-    if (info /= psb_success_) goto 9999
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine d_jac_solver_check
-
-  subroutine d_jac_solver_cseti(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    integer(psb_ipk_), intent(in)                 :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='d_jac_solver_cseti'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-    select case(psb_toupper(what))
-    case('SOLVER_SWEEPS')
-      sv%sweeps = val      
-    case default
-      call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_jac_solver_cseti
-
-  subroutine d_jac_solver_csetc(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(inout) :: sv
-    character(len=*), intent(in)                  :: what 
-    character(len=*), intent(in)                  :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act, ival
-    character(len=20)  :: name='d_jac_solver_csetc'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-
-    call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
-  
-    if (info /= psb_success_) then
-      info = psb_err_from_subroutine_
-      call psb_errpush(info, name)
-      goto 9999
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_jac_solver_csetc
-  
-  subroutine d_jac_solver_csetr(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    real(psb_dpk_), intent(in)                     :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='d_jac_solver_csetr'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    select case(psb_toupper(what))
-    case('SOLVER_EPS') 
-      sv%eps = val
-    case default
-      call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_jac_solver_csetr
-
-  subroutine d_jac_solver_free(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='d_jac_solver_free'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call sv%a%free()
-    if (allocated(sv%dv)) then
-      call sv%dv%free(info)
-      deallocate(sv%dv)
-    end if
-    if (allocated(sv%d)) deallocate(sv%d)
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_jac_solver_free
-
-  subroutine d_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_d_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_jac_solver_descr
-
-  function d_jac_solver_get_nzeros(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-    
-    val = 0 
-    val = val + sv%a%get_nzeros()
-    val = val + sv%dv%get_nrows()
-
-    return
-  end function d_jac_solver_get_nzeros
-
-  function d_jac_solver_sizeof(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-
-    val = psb_sizeof_ip 
-    val = val + sv%a%sizeof()
-    val = val + sv%dv%sizeof()
-
-    return
-  end function d_jac_solver_sizeof
-
-  function d_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "Jacobi solver"
-  end function d_jac_solver_get_fmt
-
-  function d_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_jac_
-  end function d_jac_solver_get_id
-
-  !
-  ! If this is true, then the solver needs a starting
-  ! guess. Currently only handled in JAC smoother. 
-  ! 
-  function d_jac_solver_is_iterative() result(val)
-    implicit none 
-    logical  :: val
-
-    val = .true.
-  end function d_jac_solver_is_iterative
-    
-  function d_jac_solver_get_wrksize() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = 2
-  end function d_jac_solver_get_wrksize
-
-  subroutine d_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_l1_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_d_l1_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_l1_jac_solver_descr
-
-  function d_l1_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "L1-Jacobi solver"
-  end function d_l1_jac_solver_get_fmt
-
-  function d_l1_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_l1_jac_
-  end function d_l1_jac_solver_get_id
-  
-end module amg_d_jac_solver

amgprec/amg_d_mumps_solver.F90

@@ -3,9 +3,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -78,8 +78,7 @@ module amg_d_mumps_solver
     !
     ! Controls to be set before MUMPS instantiation:
     !
-    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: 'LOCAL_SOLVER
-    !                            1==amg_global_solver_: 'GLOBAL_SOLVER'
+    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: LOCAL   1==amg_global_solver_: GLOBAL
     ! IPAR(2) : MUMPS_PRINT_ERR  print verbosity (see MUMPS)
     ! IPAR(3) : MUMPS_SYM        0: non-symmetric   2: symmetric
     integer(psb_ipk_), dimension(3) :: ipar
@@ -314,24 +313,22 @@ subroutine d_mumps_solver_finalize(sv)
 
 end subroutine d_mumps_solver_finalize
 
-subroutine d_mumps_solver_descr(sv,info,iout,coarse,prefix)
+subroutine d_mumps_solver_descr(sv,info,iout,coarse)
 
   Implicit None
 
   ! Arguments
   class(amg_d_mumps_solver_type), intent(in) :: sv
-  integer(psb_ipk_), intent(out)               :: info
-  integer(psb_ipk_), intent(in), optional      :: iout
-  logical, intent(in), optional                :: coarse
-  character(len=*), intent(in), optional       :: prefix
-      
+  integer(psb_ipk_), intent(out)                     :: info
+  integer(psb_ipk_), intent(in), optional            :: iout
+  logical, intent(in), optional       :: coarse
+
   ! Local variables
   integer(psb_ipk_)   :: err_act
   type(psb_ctxt_type) :: ctxt
   integer(psb_ipk_)   :: me, np
   character(len=20), parameter :: name='amg_z_mumps_solver_descr'
   integer(psb_ipk_) :: iout_
-  character(1024)    :: prefix_
 
   call psb_erractionsave(err_act)
   info = psb_success_
@@ -340,13 +337,8 @@ subroutine d_mumps_solver_descr(sv,info,iout,coarse,prefix)
   else
     iout_ = psb_out_unit
   endif
-  if (present(prefix)) then
-    prefix_ = prefix
-  else
-    prefix_ = ""
-  end if
 
-  write(iout_,*) trim(prefix_), '  MUMPS  Solver. '
+  write(iout_,*) '  MUMPS  Solver. '
 
   call psb_erractionrestore(err_act)
   return

amgprec/amg_d_onelev_mod.f90

@@ -1,15 +1,15 @@
-!
-!
+!  
+!   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2020 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
 !    are met:
@@ -21,7 +21,7 @@
 !      3. The name of the AMG4PSBLAS group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
-!
+!   
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -33,22 +33,22 @@
 !    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
-!
-!
+!   
+!  
 ! File: amg_d_onelev_mod.f90
 !
 ! Module: amg_d_onelev_mod
 !
-!  This module defines:
+!  This module defines: 
 !  - the amg_d_onelev_type data structure containing one level
 !    of a multilevel  preconditioner and related
 !    data structures;
 !
 !  It contains routines for
-!  - Building and applying;
+!  - Building and applying; 
 !  - checking if the preconditioner is correctly defined;
 !  - printing a	description of the preconditioner;
-!  - deallocating the preconditioner data structure.
+!  - deallocating the preconditioner data structure.  
 !
 
 module amg_d_onelev_mod
@@ -56,8 +56,6 @@ module amg_d_onelev_mod
   use amg_base_prec_type
   use amg_d_base_smoother_mod
   use amg_d_dec_aggregator_mod
-  use amg_d_parmatch_aggregator_mod
-
   use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, &
        & psb_d_base_vect_type, psb_ldspmat_type,  psb_dlinmap_type, psb_dpk_, &
        & psb_ipk_, psb_epk_, psb_lpk_, psb_desc_type, psb_i_base_vect_type, &
@@ -75,16 +73,16 @@ module amg_d_onelev_mod
   !    class(amg_d_base_smoother_type), pointer       :: sm2 => null()
   !    class(amg_dmlprec_wrk_type), allocatable       :: wrk
   !    class(amg_d_base_aggregator_type), allocatable :: aggr
-  !    type(amg_dml_parms)             :: parms
+  !    type(amg_dml_parms)             :: parms 
   !    type(psb_dspmat_type)           :: ac
   !    type(psb_desc_type)             :: desc_ac
-  !    type(psb_dspmat_type), pointer  :: base_a    => null()
-  !    type(psb_desc_type), pointer    :: base_desc => null()
+  !    type(psb_dspmat_type), pointer  :: base_a    => null() 
+  !    type(psb_desc_type), pointer    :: base_desc => null() 
   !    type(psb_dlinmap_type)          :: map
   !  end type amg_donelev_type
   !
   !  Note that d denotes the kind of the real data type to be chosen
-  !  according to single/double precision version of AMG4PSBLAS.
+  !  according to single/double precision version of MLD2P4.
   !
   !   sm,sm2a      -  class(amg_d_base_smoother_type), allocatable
   !                   The current level pre- and post-smooother.
@@ -95,7 +93,7 @@ module amg_d_onelev_mod
   !                   Workspace for application of preconditioner; may be
   !                   pre-allocated to save time in the application within a
   !                   Krylov solver.
-  !   aggr         -  class(amg_d_base_aggregator_type), allocatable
+  !   aggr         -  class(amg_d_base_aggregator_type), allocatable 
   !                   The aggregator object: holds the algorithmic choices and
   !                   (possibly) additional data for building the aggregation.
   !   parms        -  type(amg_dml_parms)
@@ -106,7 +104,7 @@ module amg_d_onelev_mod
   !                   The communication descriptor associated to the matrix
   !                   stored in ac.
   !   base_a       -  type(psb_dspmat_type), pointer.
-  !                   Pointer (really a pointer!) to the local part of the current
+  !                   Pointer (really a pointer!) to the local part of the current 
   !                   matrix (so we have a unified treatment of residuals).
   !                   We need this to avoid passing explicitly the current matrix
   !                   to the routine which applies the preconditioner.
@@ -117,13 +115,13 @@ module amg_d_onelev_mod
   !                   vector spaces associated to the index spaces of the previous
   !                   and current levels.
   !
-  !   Methods:
+  !   Methods:  
   !     Most methods follow the encapsulation hierarchy: they take whatever action
   !     is appropriate for the current object, then call the corresponding method for
   !     the contained object.
   !     As an example: the descr() method prints out a description of the
   !     level. It starts by invoking the descr() method of the parms object,
-  !     then calls the descr() method of the smoother object.
+  !     then calls the descr() method of the smoother object. 
   !
   !    descr      -   Prints a description of the object.
   !    default    -   Set default values
@@ -132,14 +130,14 @@ module amg_d_onelev_mod
   !                   it is passed to the smoother object for further processing.
   !    check        -  Sanity checks.
   !    sizeof       -  Total memory occupation in bytes
-  !    get_nzeros   -  Number of nonzeros
+  !    get_nzeros   -  Number of nonzeros 
   !    get_wrksz    -  How many workspace vector does apply_vect need
   !    allocate_wrk -  Allocate auxiliary workspace
   !    free_wrk     -  Free     auxiliary workspace
   !    bld_tprol    -  Invoke the aggr method to build the tentative prolongator
-  !    mat_asb      -  Build the final (possibly smoothed) prolongator and coarse matrix.
-  !
+  !    mat_asb      -  Build the final (possibly smoothed) prolongator and coarse matrix. 
   !
+  !  
   type amg_dmlprec_wrk_type
     real(psb_dpk_), allocatable  :: tx(:), ty(:), x2l(:), y2l(:)
     type(psb_d_vect_type)  :: vtx, vty, vx2l, vy2l
@@ -150,35 +148,25 @@ module amg_d_onelev_mod
     procedure, pass(wk) :: clone      => d_wrk_clone
     procedure, pass(wk) :: move_alloc => d_wrk_move_alloc
     procedure, pass(wk) :: cnv        => d_wrk_cnv
-    procedure, pass(wk) :: sizeof     => d_wrk_sizeof
+    procedure, pass(wk) :: sizeof     => d_wrk_sizeof    
   end type amg_dmlprec_wrk_type
   private :: d_wrk_alloc, d_wrk_free, &
-       & d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv, d_wrk_sizeof
-
-  type amg_d_remap_data_type
-    type(psb_dspmat_type)          :: ac_pre_remap
-    type(psb_desc_type)            :: desc_ac_pre_remap
-    integer(psb_ipk_)              :: idest
-    integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
-  contains
-    procedure, pass(rmp) :: clone   => d_remap_data_clone
-  end type amg_d_remap_data_type
-
+       & d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv, d_wrk_sizeof    
+  
   type amg_d_onelev_type
     class(amg_d_base_smoother_type), allocatable   :: sm, sm2a
     class(amg_d_base_smoother_type), pointer       :: sm2 => null()
     class(amg_dmlprec_wrk_type), allocatable       :: wrk
     class(amg_d_base_aggregator_type), allocatable :: aggr
-    type(amg_dml_parms)              :: parms
+    type(amg_dml_parms)              :: parms 
     type(psb_dspmat_type)            :: ac
     integer(psb_ipk_)                :: ac_nz_loc
     integer(psb_lpk_)                :: ac_nz_tot
     type(psb_desc_type)              :: desc_ac
-    type(psb_dspmat_type), pointer   :: base_a    => null()
-    type(psb_desc_type), pointer     :: base_desc => null()
+    type(psb_dspmat_type), pointer   :: base_a    => null() 
+    type(psb_desc_type), pointer     :: base_desc => null() 
     type(psb_ldspmat_type)           :: tprol
-    type(psb_dlinmap_type)           :: linmap
-    type(amg_d_remap_data_type)      :: remap_data
+    type(psb_dlinmap_type)           :: map
     real(psb_dpk_)                     :: szratio
   contains
     procedure, pass(lv) :: bld_tprol   => d_base_onelev_bld_tprol
@@ -188,10 +176,8 @@ module amg_d_onelev_mod
     procedure, pass(lv) :: clone   => d_base_onelev_clone
     procedure, pass(lv) :: cnv     => amg_d_base_onelev_cnv
     procedure, pass(lv) :: descr   => amg_d_base_onelev_descr
-    procedure, pass(lv) :: memory_use  => amg_d_base_onelev_memory_use
     procedure, pass(lv) :: default => d_base_onelev_default
     procedure, pass(lv) :: free    => amg_d_base_onelev_free
-    procedure, pass(lv) :: free_smoothers => amg_d_base_onelev_free_smoothers
     procedure, pass(lv) :: nullify => d_base_onelev_nullify
     procedure, pass(lv) :: check => amg_d_base_onelev_check
     procedure, pass(lv) :: dump  => amg_d_base_onelev_dump
@@ -201,7 +187,7 @@ module amg_d_onelev_mod
     procedure, pass(lv) :: setsm => amg_d_base_onelev_setsm
     procedure, pass(lv) :: setsv => amg_d_base_onelev_setsv
     procedure, pass(lv) :: setag => amg_d_base_onelev_setag
-    generic, public     :: set   => cseti, csetr, csetc, setsm, setsv, setag
+    generic, public     :: set   => cseti, csetr, csetc, setsm, setsv, setag 
     procedure, pass(lv) :: sizeof => d_base_onelev_sizeof
     procedure, pass(lv) :: get_nzeros => d_base_onelev_get_nzeros
     procedure, pass(lv) :: get_wrksz => d_base_onelev_get_wrksize
@@ -209,14 +195,7 @@ module amg_d_onelev_mod
     procedure, pass(lv) :: free_wrk       => d_base_onelev_free_wrk
     procedure, nopass   :: stringval => amg_stringval
     procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc
-
-
-    procedure, pass(lv) :: map_rstr_a => amg_d_base_onelev_map_rstr_a
-    procedure, pass(lv) :: map_prol_a => amg_d_base_onelev_map_prol_a
-    procedure, pass(lv) :: map_rstr_v => amg_d_base_onelev_map_rstr_v
-    procedure, pass(lv) :: map_prol_v => amg_d_base_onelev_map_prol_v
-    generic, public     :: map_rstr => map_rstr_a, map_rstr_v
-    generic, public     :: map_prol => map_prol_a, map_prol_v
+    
   end type amg_d_onelev_type
 
   type amg_d_onelev_node
@@ -230,11 +209,11 @@ module amg_d_onelev_mod
        & d_base_onelev_get_wrksize, d_base_onelev_allocate_wrk, &
        & d_base_onelev_free_wrk
 
-  interface
+  interface 
     subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
       import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_, psb_ldspmat_type, psb_lpk_
       import :: amg_d_onelev_type
-      implicit none
+      implicit none 
       class(amg_d_onelev_type), intent(inout), target :: lv
       type(psb_dspmat_type), intent(in) :: a
       type(psb_desc_type), intent(inout)  :: desc_a
@@ -259,172 +238,141 @@ module amg_d_onelev_mod
     end subroutine amg_d_base_onelev_build
   end interface
 
-  interface
-    subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
+  interface 
+    subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
            & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
       ! Arguments
-      class(amg_d_onelev_type), intent(in)    :: lv
-      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
+      class(amg_d_onelev_type), intent(in) :: lv
+      integer(psb_ipk_), intent(in)                 :: il,nl,ilmin
+      integer(psb_ipk_), intent(out)                :: info
+      integer(psb_ipk_), intent(in), optional       :: iout
     end subroutine amg_d_base_onelev_descr
   end interface
 
-  interface
-    subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
-      Implicit None
-      ! Arguments
-      class(amg_d_onelev_type), intent(in)    :: lv
-      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_d_base_onelev_memory_use
-  end interface
-
-  interface
+  interface 
     subroutine amg_d_base_onelev_cnv(lv,info,amold,vmold,imold)
       import :: amg_d_onelev_type, psb_d_base_vect_type, psb_dpk_, &
            & psb_d_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
       ! Arguments
-      class(amg_d_onelev_type), intent(inout)            :: lv
+      class(amg_d_onelev_type), intent(inout)            :: lv 
       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 amg_d_base_onelev_cnv
   end interface
-
-  interface
+   
+interface 
     subroutine amg_d_base_onelev_free(lv,info)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
            & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
-      implicit none
-
+      implicit none 
+      
       class(amg_d_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_d_base_onelev_free
   end interface
-
-  interface
-    subroutine amg_d_base_onelev_free_smoothers(lv,info)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
-      implicit none
-
-      class(amg_d_onelev_type), intent(inout) :: lv
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_d_base_onelev_free_smoothers
-  end interface
-
-  interface
+  
+  interface 
     subroutine amg_d_base_onelev_check(lv,info)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
            & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
       ! Arguments
-      class(amg_d_onelev_type), intent(inout) :: lv
+      class(amg_d_onelev_type), intent(inout) :: lv 
       integer(psb_ipk_), intent(out)            :: info
     end subroutine amg_d_base_onelev_check
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_d_base_onelev_setsm(lv,val,info,pos)
       import :: psb_dpk_, amg_d_onelev_type, amg_d_base_smoother_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
+      
       ! Arguments
-      class(amg_d_onelev_type), target, intent(inout) :: lv
+      class(amg_d_onelev_type), target, intent(inout) :: lv 
       class(amg_d_base_smoother_type), intent(in)     :: val
       integer(psb_ipk_), intent(out)                  :: info
       character(len=*), optional, intent(in)          :: pos
     end subroutine amg_d_base_onelev_setsm
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_d_base_onelev_setsv(lv,val,info,pos)
       import :: psb_dpk_, amg_d_onelev_type, amg_d_base_solver_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
+      
       ! Arguments
-      class(amg_d_onelev_type), target, intent(inout) :: lv
+      class(amg_d_onelev_type), target, intent(inout) :: lv 
       class(amg_d_base_solver_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
       character(len=*), optional, intent(in)          :: pos
     end subroutine amg_d_base_onelev_setsv
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_d_base_onelev_setag(lv,val,info,pos)
       import :: psb_dpk_, amg_d_onelev_type, amg_d_base_aggregator_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
+      
       ! Arguments
-      class(amg_d_onelev_type), target, intent(inout) :: lv
+      class(amg_d_onelev_type), target, intent(inout) :: lv 
       class(amg_d_base_aggregator_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
       character(len=*), optional, intent(in)          :: pos
     end subroutine amg_d_base_onelev_setag
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
            & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
+      
       ! Arguments
-      class(amg_d_onelev_type), intent(inout) :: lv
-      character(len=*), intent(in)              :: what
+      class(amg_d_onelev_type), intent(inout) :: lv 
+      character(len=*), intent(in)              :: what 
       integer(psb_ipk_), intent(in)             :: val
       integer(psb_ipk_), intent(out)            :: info
       character(len=*), optional, intent(in)      :: pos
     integer(psb_ipk_), intent(in), optional       :: idx
     end subroutine amg_d_base_onelev_cseti
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
            & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
       ! Arguments
-      class(amg_d_onelev_type), intent(inout) :: lv
-      character(len=*), intent(in)              :: what
+      class(amg_d_onelev_type), intent(inout) :: lv 
+      character(len=*), intent(in)              :: what 
       character(len=*), intent(in)              :: val
       integer(psb_ipk_), intent(out)            :: info
       character(len=*), optional, intent(in)      :: pos
     integer(psb_ipk_), intent(in), optional       :: idx
     end subroutine amg_d_base_onelev_csetc
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_d_base_onelev_csetr(lv,what,val,info,pos,idx)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
            & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
-      class(amg_d_onelev_type), intent(inout) :: lv
-      character(len=*), intent(in)              :: what
+      
+      class(amg_d_onelev_type), intent(inout) :: lv 
+      character(len=*), intent(in)              :: what 
       real(psb_dpk_), intent(in)                 :: val
       integer(psb_ipk_), intent(out)            :: info
       character(len=*), optional, intent(in)      :: pos
@@ -432,13 +380,13 @@ module amg_d_onelev_mod
     end subroutine amg_d_base_onelev_csetr
   end interface
 
-  interface
+  interface 
     subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
          & solver,tprol,global_num)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
            & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
-      implicit none
+      implicit none 
       class(amg_d_onelev_type), intent(in) :: lv
       integer(psb_ipk_), intent(in)          :: level
       integer(psb_ipk_), intent(out)         :: info
@@ -446,62 +394,15 @@ module amg_d_onelev_mod
       logical, optional, intent(in)    :: ac, rp, smoother, solver, tprol, global_num
     end subroutine amg_d_base_onelev_dump
   end interface
-
-  interface
-    subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
-      import
-      implicit none
-      class(amg_d_onelev_type), target, intent(inout) :: lv
-      real(psb_dpk_), intent(in)     :: alpha, beta
-      real(psb_dpk_), intent(inout)   :: u(:)
-      real(psb_dpk_), intent(out)     :: v(:)
-      integer(psb_ipk_), intent(out) :: info
-      real(psb_dpk_), optional       :: work(:)
-    end subroutine amg_d_base_onelev_map_rstr_a
-    subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
-      import
-      implicit none
-      class(amg_d_onelev_type), target, intent(inout) :: lv
-      real(psb_dpk_), intent(in)           :: alpha, beta
-      type(psb_d_vect_type), intent(inout) :: vect_u, vect_v
-      integer(psb_ipk_), intent(out)       :: info
-      real(psb_dpk_), optional          :: work(:)
-      type(psb_d_vect_type), optional, target, intent(inout)  :: vtx,vty
-    end subroutine amg_d_base_onelev_map_rstr_v
-  end interface
-
-  interface
-    subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
-      import
-      implicit none
-      class(amg_d_onelev_type), target, intent(inout) :: lv
-      real(psb_dpk_), intent(in)     :: alpha, beta
-      real(psb_dpk_), intent(inout)   :: u(:)
-      real(psb_dpk_), intent(out)     :: v(:)
-      integer(psb_ipk_), intent(out) :: info
-      real(psb_dpk_), optional          :: work(:)
-
-    end subroutine amg_d_base_onelev_map_prol_a
-    subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
-      import
-      implicit none
-      class(amg_d_onelev_type), target, intent(inout) :: lv
-      real(psb_dpk_), intent(in)           :: alpha, beta
-      type(psb_d_vect_type), intent(inout) :: vect_u, vect_v
-      integer(psb_ipk_), intent(out)       :: info
-      real(psb_dpk_), optional          :: work(:)
-      type(psb_d_vect_type), optional, target, intent(inout)  :: vtx,vty
-    end subroutine amg_d_base_onelev_map_prol_v
-  end interface
-
+  
 contains
   !
   ! Function returning the size of the amg_prec_type data structure
-  ! in bytes or in number of nonzeros of the operator(s) involved.
+  ! in bytes or in number of nonzeros of the operator(s) involved. 
   !
 
   function d_base_onelev_get_nzeros(lv) result(val)
-    implicit none
+    implicit none 
     class(amg_d_onelev_type), intent(in) :: lv
     integer(psb_epk_) :: val
     integer(psb_ipk_)        :: i
@@ -513,16 +414,16 @@ contains
   end function d_base_onelev_get_nzeros
 
   function d_base_onelev_sizeof(lv) result(val)
-    implicit none
+    implicit none 
     class(amg_d_onelev_type), intent(in) :: lv
     integer(psb_epk_) :: val
     integer(psb_ipk_)        :: i
-
+    
     val = psb_sizeof_ip+psb_sizeof_lp
     val = val + lv%desc_ac%sizeof()
     val = val + lv%ac%sizeof()
     val = val + lv%tprol%sizeof()
-    val = val + lv%linmap%sizeof()
+    val = val + lv%map%sizeof() 
     if (allocated(lv%sm))   val = val + lv%sm%sizeof()
     if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
     if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -531,19 +432,19 @@ contains
 
 
   subroutine d_base_onelev_nullify(lv)
-    implicit none
+    implicit none 
 
     class(amg_d_onelev_type), intent(inout) :: lv
 
-    nullify(lv%base_a)
-    nullify(lv%base_desc)
+    nullify(lv%base_a) 
+    nullify(lv%base_desc) 
     nullify(lv%sm2)
   end subroutine d_base_onelev_nullify
 
   !
-  ! Multilevel defaults:
+  ! Multilevel defaults: 
   !  multiplicative vs. additive ML framework;
-  !  Smoothed decoupled aggregation with zero threshold;
+  !  Smoothed decoupled aggregation with zero threshold; 
   !  distributed coarse matrix;
   !  damping omega  computed with the max-norm estimate of the
   !  dominant eigenvalue;
@@ -553,10 +454,10 @@ contains
   subroutine d_base_onelev_default(lv)
 
     Implicit None
-
+ 
     ! Arguments
     class(amg_d_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_) :: info
+    integer(psb_ipk_) :: info 
 
     lv%parms%sweeps_pre      = 1
     lv%parms%sweeps_post     = 1
@@ -571,7 +472,7 @@ contains
     lv%parms%aggr_filter     = amg_no_filter_mat_
     lv%parms%aggr_omega_val  = dzero
     lv%parms%aggr_thresh     = 0.01_psb_dpk_
-
+    
     if (allocated(lv%sm)) call lv%sm%default()
     if (allocated(lv%sm2a)) then
       call lv%sm2a%default()
@@ -581,7 +482,7 @@ contains
     end if
     if (.not.allocated(lv%aggr)) allocate(amg_d_dec_aggregator_type :: lv%aggr,stat=info)
     if (allocated(lv%aggr)) call lv%aggr%default()
-
+    
     return
 
   end subroutine d_base_onelev_default
@@ -596,9 +497,9 @@ contains
     type(psb_ldspmat_type), intent(out)  :: t_prol
     type(amg_daggr_data), intent(in)    :: ag_data
     integer(psb_ipk_), intent(out)      :: info
-
+    
     call lv%aggr%bld_tprol(lv%parms,ag_data,a,desc_a,ilaggr,nlaggr,t_prol,info)
-
+    
   end subroutine d_base_onelev_bld_tprol
 
 
@@ -608,7 +509,7 @@ contains
     integer(psb_ipk_), intent(out)      :: info
 
     call lv%aggr%update_next(lvnext%aggr,info)
-
+    
   end subroutine d_base_onelev_update_aggr
 
 
@@ -617,33 +518,33 @@ contains
     Implicit None
 
     ! Arguments
-    class(amg_d_onelev_type), target, intent(inout) :: lv
+    class(amg_d_onelev_type), target, intent(inout) :: lv 
     class(amg_d_onelev_type), target, intent(inout) :: lvout
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
 
     info = psb_success_
-    if (allocated(lv%sm)) then
+    if (allocated(lv%sm)) then 
       call lv%sm%clone(lvout%sm,info)
-    else
-      if (allocated(lvout%sm)) then
+    else 
+      if (allocated(lvout%sm)) then 
         call lvout%sm%free(info)
         if (info==psb_success_) deallocate(lvout%sm,stat=info)
       end if
     end if
-    if (allocated(lv%sm2a)) then
+    if (allocated(lv%sm2a)) then 
       call lv%sm%clone(lvout%sm2a,info)
       lvout%sm2 => lvout%sm2a
-    else
-      if (allocated(lvout%sm2a)) then
+    else 
+      if (allocated(lvout%sm2a)) then 
         call lvout%sm2a%free(info)
         if (info==psb_success_) deallocate(lvout%sm2a,stat=info)
       end if
       lvout%sm2 => lvout%sm
     end if
-    if (allocated(lv%aggr)) then
+    if (allocated(lv%aggr)) then 
       call  lv%aggr%clone(lvout%aggr,info)
     else
-      if (allocated(lvout%aggr)) then
+      if (allocated(lvout%aggr)) then 
         call lvout%aggr%free(info)
         if (info==psb_success_) deallocate(lvout%aggr,stat=info)
       end if
@@ -652,11 +553,10 @@ contains
     if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
     if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
     if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
-    if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
-    if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
+    if (info == psb_success_) call lv%map%clone(lvout%map,info)
     lvout%base_a    => lv%base_a
     lvout%base_desc => lv%base_desc
-
+    
     return
 
   end subroutine d_base_onelev_clone
@@ -665,12 +565,12 @@ contains
     use psb_base_mod
     implicit none
     class(amg_d_onelev_type), target, intent(inout) :: lv, b
-    integer(psb_ipk_), intent(out) :: info
-
+    integer(psb_ipk_), intent(out) :: info 
+    
     call b%free(info)
     b%parms  = lv%parms
     b%szratio = lv%szratio
-    if (associated(lv%sm2,lv%sm2a)) then
+    if (associated(lv%sm2,lv%sm2a)) then 
       call move_alloc(lv%sm,b%sm)
       call move_alloc(lv%sm2a,b%sm2a)
       b%sm2 =>b%sm2a
@@ -681,18 +581,18 @@ contains
     end if
 
     call move_alloc(lv%aggr,b%aggr)
-    if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
-    if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
-    if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
-    if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
+    if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info) 
+    if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info) 
+    if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info) 
+    if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info) 
     b%base_a    => lv%base_a
     b%base_desc => lv%base_desc
-
+    
   end subroutine d_base_onelev_move_alloc
 
-
+  
   function d_base_onelev_get_wrksize(lv) result(val)
-    implicit none
+    implicit none 
     class(amg_d_onelev_type), intent(inout) :: lv
     integer(psb_ipk_)  :: val
 
@@ -713,54 +613,44 @@ contains
     select case(lv%parms%ml_cycle)
     case(amg_add_ml_,amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
       ! We're good
-
+      
     case(amg_kcycle_ml_, amg_kcyclesym_ml_)
       !
       ! We need 7 in inneritkcycle.
-      !  Can we reuse vtx?
-      !
+      !  Can we reuse vtx? 
+      ! 
       val = val + 7
-
+      
     case default
       ! Need a better error signaling ?
       val = -1
     end select
-
+    
   end function d_base_onelev_get_wrksize
 
   subroutine d_base_onelev_allocate_wrk(lv,info,vmold)
     use psb_base_mod
     implicit none
     class(amg_d_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
+    integer(psb_ipk_), intent(out) :: info 
     class(psb_d_base_vect_type), intent(in), optional  :: vmold
     !
     integer(psb_ipk_) :: nwv, i
     info = psb_success_
     nwv = lv%get_wrksz()
     if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
-    if (info == 0) then
-      if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
-        !
-        !  Need to fix this, we need two different allocations
-        !
-        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
-             & desc2=lv%remap_data%desc_ac_pre_remap)
-      else
-        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
-      end if
-    end if
-
+    if (info == 0) call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
+    
   end subroutine d_base_onelev_allocate_wrk
 
-
+  
   subroutine d_base_onelev_free_wrk(lv,info)
     use psb_base_mod
     implicit none
     class(amg_d_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
+    integer(psb_ipk_), intent(out) :: info 
     !
-    integer(psb_ipk_) :: nwv,i
+    integer(psb_ipk_) :: nwv,i 
     info = psb_success_
 
     if (allocated(lv%wrk)) then
@@ -768,88 +658,46 @@ contains
       if (info == 0) deallocate(lv%wrk,stat=info)
     end if
   end subroutine d_base_onelev_free_wrk
-
-  subroutine d_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
+  
+  subroutine d_wrk_alloc(wk,nwv,desc,info,vmold)
     use psb_base_mod
-
+    
     Implicit None
-
+    
     ! Arguments
     class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
     integer(psb_ipk_), intent(in)                     :: nwv
     type(psb_desc_type), intent(in)                   :: desc
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
     class(psb_d_base_vect_type), intent(in), optional  :: vmold
-    type(psb_desc_type), intent(in), optional          :: desc2
     !
     integer(psb_ipk_) :: i
 
     info = psb_success_
     call wk%free(info)
-    if  (present(desc2)) then
-!!$      write(0,*) 'Check on wrk_alloc 2',&
-!!$           & desc2%get_local_rows(), desc%get_local_rows(),&
-!!$           & desc2%get_local_cols(),desc%get_local_cols()
-!!$      flush(0)
-      if (desc2%get_local_cols()>desc%get_local_cols()) then
-        call psb_geasb(wk%vx2l,desc2,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vy2l,desc2,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vtx,desc2,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vty,desc2,info,&
-             & scratch=.true.,mold=vmold)
-        allocate(wk%wv(nwv),stat=info)
-        do i=1,nwv
-          call psb_geasb(wk%wv(i),desc2,info,&
-               & scratch=.true.,mold=vmold)
-        end do
-      else
-!!$        write(0,*) 'Check on wrk_alloc 1.5 ',&
-!!$             & desc%get_local_rows(),&
-!!$             & desc%get_local_cols()
-        call psb_geasb(wk%vx2l,desc,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vy2l,desc,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vtx,desc,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vty,desc,info,&
-             & scratch=.true.,mold=vmold)
-        allocate(wk%wv(nwv),stat=info)
-        do i=1,nwv
-          call psb_geasb(wk%wv(i),desc,info,&
-               & scratch=.true.,mold=vmold)
-        end do
-      end if
-    else
-!!$      write(0,*) 'Check on wrk_alloc 1 ',&
-!!$           & desc%get_local_rows(),&
-!!$           & desc%get_local_cols()
-      call psb_geasb(wk%vx2l,desc,info,&
+    call psb_geasb(wk%vx2l,desc,info,&
+         & scratch=.true.,mold=vmold)
+    call psb_geasb(wk%vy2l,desc,info,&
+         & scratch=.true.,mold=vmold)
+    call psb_geasb(wk%vtx,desc,info,&
+         & scratch=.true.,mold=vmold)
+    call psb_geasb(wk%vty,desc,info,&
+         & scratch=.true.,mold=vmold)
+    allocate(wk%wv(nwv),stat=info)
+    do i=1,nwv
+      call psb_geasb(wk%wv(i),desc,info,&
            & scratch=.true.,mold=vmold)
-      call psb_geasb(wk%vy2l,desc,info,&
-           & scratch=.true.,mold=vmold)
-      call psb_geasb(wk%vtx,desc,info,&
-           & scratch=.true.,mold=vmold)
-      call psb_geasb(wk%vty,desc,info,&
-           & scratch=.true.,mold=vmold)
-      allocate(wk%wv(nwv),stat=info)
-      do i=1,nwv
-        call psb_geasb(wk%wv(i),desc,info,&
-             & scratch=.true.,mold=vmold)
-      end do
-    end if
+    end do
+    
   end subroutine d_wrk_alloc
-
+    
   subroutine d_wrk_free(wk,info)
 
     Implicit None
 
     ! Arguments
     class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
     !
     integer(psb_ipk_) :: i
     info = psb_success_
@@ -870,7 +718,7 @@ contains
     end if
 
   end subroutine d_wrk_free
-
+    
   subroutine d_wrk_clone(wk,wkout,info)
     use psb_base_mod
     Implicit None
@@ -878,11 +726,11 @@ contains
     ! Arguments
     class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
     class(amg_dmlprec_wrk_type), target, intent(inout) :: wkout
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
     !
     integer(psb_ipk_) :: i
     info = psb_success_
-
+    
     call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
     call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
     call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
@@ -904,12 +752,12 @@ contains
     return
 
   end subroutine d_wrk_clone
-
+  
   subroutine d_wrk_move_alloc(wk, b,info)
     implicit none
     class(amg_dmlprec_wrk_type), target, intent(inout) :: wk, b
-    integer(psb_ipk_), intent(out) :: info
-
+    integer(psb_ipk_), intent(out) :: info 
+    
     call b%free(info)
     call move_alloc(wk%tx,b%tx)
     call move_alloc(wk%ty,b%ty)
@@ -922,17 +770,17 @@ contains
     call move_alloc(wk%vx2l%v,b%vx2l%v)
     call move_alloc(wk%vy2l%v,b%vy2l%v)
     call move_alloc(wk%wv,b%wv)
-
+        
   end subroutine d_wrk_move_alloc
 
   subroutine d_wrk_cnv(wk,info,vmold)
     use psb_base_mod
-
+    
     Implicit None
-
+    
     ! Arguments
     class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
     class(psb_d_base_vect_type), intent(in), optional  :: vmold
     !
     integer(psb_ipk_) :: i
@@ -953,7 +801,7 @@ contains
 
   function d_wrk_sizeof(wk) result(val)
     use psb_realloc_mod
-    implicit none
+    implicit none 
     class(amg_dmlprec_wrk_type), intent(in) :: wk
     integer(psb_epk_) :: val
     integer :: i
@@ -972,25 +820,5 @@ contains
       end do
     end if
   end function d_wrk_sizeof
-
-  subroutine d_remap_data_clone(rmp, remap_out, info)
-    use psb_base_mod
-    implicit none
-    ! Arguments
-    class(amg_d_remap_data_type), target, intent(inout) :: rmp
-    class(amg_d_remap_data_type), target, intent(inout) :: remap_out
-    integer(psb_ipk_), intent(out)                    :: info
-    !
-    integer(psb_ipk_) :: i
-
-    info = psb_success_
-
-    call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
-    if (info == psb_success_) &
-         & call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
-    remap_out%idest = rmp%idest
-    call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
-    call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
-  end subroutine d_remap_data_clone
-
+ 
 end module amg_d_onelev_mod

amgprec/amg_d_parmatch_aggregator_mod.F90

@@ -1,689 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-! moved here from amg4psblas-extension
-!
-!
-!                             AMG4PSBLAS  Extensions
-!
-!    (C) Copyright 2019
-!
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-!
-!
-!  The aggregator object hosts the aggregation method for building
-!  the multilevel hierarchy. This variant is based on the hybrid method
-!  presented in
-!
-!
-!   sm           -  class(amg_T_base_smoother_type), allocatable
-!                   The current level preconditioner (aka smoother).
-!   parms        -  type(amg_RTml_parms)
-!                   The parameters defining the multilevel strategy.
-!   ac           -  The local part of the current-level matrix, built by
-!                   coarsening the previous-level matrix.
-!   desc_ac      -  type(psb_desc_type).
-!                   The communication descriptor associated to the matrix
-!                   stored in ac.
-!   base_a       -  type(psb_Tspmat_type), pointer.
-!                   Pointer (really a pointer!) to the local part of the current
-!                   matrix (so we have a unified treatment of residuals).
-!                   We need this to avoid passing explicitly the current matrix
-!                   to the routine which applies the preconditioner.
-!   base_desc    -  type(psb_desc_type), pointer.
-!                   Pointer to the communication descriptor associated to the
-!                   matrix pointed by base_a.
-!   map          -  Stores the maps (restriction and prolongation) between the
-!                   vector spaces associated to the index spaces of the previous
-!                   and current levels.
-!
-!   Methods:
-!     Most methods follow the encapsulation hierarchy: they take whatever action
-!     is appropriate for the current object, then call the corresponding method for
-!     the contained object.
-!     As an example: the descr() method prints out a description of the
-!     level. It starts by invoking the descr() method of the parms object,
-!     then calls the descr() method of the smoother object.
-!
-!    descr      -   Prints a description of the object.
-!    default    -   Set default values
-!    dump       -   Dump to file object contents
-!    set        -   Sets various parameters; when a request is unknown
-!                   it is passed to the smoother object for further processing.
-!    check      -   Sanity checks.
-!    sizeof     -   Total memory occupation in bytes
-!    get_nzeros -   Number of nonzeros
-!
-!
-
-module amg_d_parmatch_aggregator_mod
-  use amg_d_base_aggregator_mod
-  use amg_d_matchboxp_mod
-#if defined(SERIAL_MPI)
-  type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
-  end type amg_d_parmatch_aggregator_type
-#else 
-  type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
-    integer(psb_ipk_) :: matching_alg
-    integer(psb_ipk_) :: n_sweeps   ! When n_sweeps >1 we need an auxiliary descriptor
-    integer(psb_ipk_) :: orig_aggr_size
-    integer(psb_ipk_) :: jacobi_sweeps
-    real(psb_dpk_), allocatable :: w(:), w_nxt(:)
-    type(psb_dspmat_type), allocatable  :: prol, restr
-    type(psb_dspmat_type), allocatable  :: ac, base_a, rwa
-    type(psb_desc_type), allocatable    :: desc_ac, desc_ax, base_desc, rwdesc
-    logical           :: reproducible_matching = .false.
-    logical           :: need_symmetrize       = .false.
-    logical           :: unsmoothed_hierarchy  = .true.
-  contains
-    procedure, pass(ag) :: bld_tprol    => amg_d_parmatch_aggregator_build_tprol
-    procedure, pass(ag) :: mat_bld      => amg_d_parmatch_aggregator_mat_bld
-    procedure, pass(ag) :: mat_asb      => amg_d_parmatch_aggregator_mat_asb
-    procedure, pass(ag) :: inner_mat_asb      => amg_d_parmatch_aggregator_inner_mat_asb
-    procedure, pass(ag) :: bld_map      => amg_d_parmatch_aggregator_bld_map
-    procedure, pass(ag) :: csetc        => amg_d_parmatch_aggr_csetc
-    procedure, pass(ag) :: cseti        => amg_d_parmatch_aggr_cseti
-    procedure, pass(ag) :: default      => amg_d_parmatch_aggr_set_default
-    procedure, pass(ag) :: sizeof       => amg_d_parmatch_aggregator_sizeof
-    procedure, pass(ag) :: update_next  => amg_d_parmatch_aggregator_update_next
-    procedure, pass(ag) :: bld_wnxt     => amg_d_parmatch_bld_wnxt
-    procedure, pass(ag) :: bld_default_w    => amg_d_bld_default_w
-    procedure, pass(ag) :: set_c_default_w  => amg_d_set_prm_c_default_w
-    procedure, pass(ag) :: descr        => amg_d_parmatch_aggregator_descr
-    procedure, pass(ag) :: clone        => amg_d_parmatch_aggregator_clone
-    procedure, pass(ag) :: free         => amg_d_parmatch_aggregator_free
-    procedure, nopass   :: fmt          => amg_d_parmatch_aggregator_fmt
-    procedure, nopass   :: xt_desc      => amg_d_parmatch_aggregator_xt_desc
-  end type amg_d_parmatch_aggregator_type
-
-  interface
-    subroutine  amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
-         & a,desc_a,ilaggr,nlaggr,t_prol,info)
-      import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
-           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
-      implicit none
-      class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
-      type(amg_dml_parms), intent(inout)   :: parms
-      type(amg_daggr_data), intent(in)     :: ag_data
-      type(psb_dspmat_type), intent(inout) :: a
-      type(psb_desc_type), intent(inout)     :: desc_a
-      integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
-      type(psb_ldspmat_type), intent(out)  :: t_prol
-      integer(psb_ipk_), intent(out)      :: info
-    end subroutine amg_d_parmatch_aggregator_build_tprol
-  end interface
-
-  interface
-    subroutine  amg_d_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
-           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
-      implicit none
-      class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
-      type(amg_dml_parms), intent(inout)   :: parms
-      type(psb_dspmat_type), intent(in)    :: a
-      type(psb_desc_type), intent(inout)   :: desc_a
-      integer(psb_lpk_), intent(inout)     :: ilaggr(:), nlaggr(:)
-      type(psb_ldspmat_type), intent(inout)   :: t_prol
-      type(psb_dspmat_type), intent(out)   ::  op_prol,ac,op_restr
-      type(psb_desc_type), intent(inout)    :: desc_ac
-      integer(psb_ipk_), intent(out)       :: info
-    end subroutine amg_d_parmatch_aggregator_mat_bld
-  end interface
-
-  interface
-    subroutine  amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
-         & ac,desc_ac, op_prol,op_restr,info)
-      import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
-           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
-      implicit none
-      class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
-      type(amg_dml_parms), intent(inout)    :: parms
-      type(psb_dspmat_type), intent(in)     :: a
-      type(psb_desc_type), intent(inout)    :: desc_a
-      type(psb_dspmat_type), intent(inout) :: op_prol,ac,op_restr
-      type(psb_desc_type), intent(inout)    :: desc_ac
-      integer(psb_ipk_), intent(out)        :: info
-    end subroutine amg_d_parmatch_aggregator_mat_asb
-  end interface
-
-
-  interface
-    subroutine  amg_d_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
-         & ac,desc_ac, op_prol,op_restr,info)
-      import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
-           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
-      implicit none
-      class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
-      type(amg_dml_parms), intent(inout)    :: parms
-      type(psb_dspmat_type), intent(in)     :: a
-      type(psb_desc_type), intent(in)       :: desc_a
-      type(psb_dspmat_type), intent(inout) :: op_prol,op_restr
-      type(psb_dspmat_type), intent(inout)  :: ac
-      type(psb_desc_type), intent(inout)    :: desc_ac
-      integer(psb_ipk_), intent(out)        :: info
-    end subroutine amg_d_parmatch_aggregator_inner_mat_asb
-  end interface
-
-
-  interface
-    subroutine amg_d_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
-           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
-      implicit none
-      type(psb_dspmat_type), intent(in)       :: a
-      type(psb_desc_type), intent(inout)       :: desc_a
-      integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-      type(amg_dml_parms), intent(inout)      :: parms
-      type(psb_ldspmat_type), intent(inout)   :: t_prol
-      type(psb_dspmat_type), intent(inout)    :: ac, op_prol, op_restr
-      type(psb_desc_type), intent(out)        :: desc_ac
-      integer(psb_ipk_), intent(out)          :: info
-    end subroutine amg_d_parmatch_spmm_bld
-  end interface
-
-  interface
-    subroutine amg_d_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
-           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
-      implicit none
-      class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
-      type(psb_dspmat_type), intent(in)       :: a
-      type(psb_desc_type), intent(inout)      :: desc_a
-      integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-      type(amg_dml_parms), intent(inout)      :: parms
-      type(psb_ldspmat_type), intent(inout)   :: t_prol
-      type(psb_dspmat_type), intent(inout)      :: op_prol,ac, op_restr
-      type(psb_desc_type), intent(inout)    :: desc_ac
-      integer(psb_ipk_), intent(out)          :: info
-    end subroutine amg_d_parmatch_unsmth_bld
-  end interface
-
-  interface
-    subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
-           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
-      implicit none
-      class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
-      type(psb_dspmat_type), intent(in)       :: a
-      type(psb_desc_type), intent(inout)      :: desc_a
-      integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-      type(amg_dml_parms), intent(inout)      :: parms
-      type(psb_ldspmat_type), intent(inout)   :: t_prol
-      type(psb_dspmat_type), intent(inout)    :: op_prol,ac, op_restr
-      type(psb_desc_type), intent(inout)    :: desc_ac
-      integer(psb_ipk_), intent(out)          :: info
-    end subroutine amg_d_parmatch_smth_bld
-  end interface
-
-  interface
-    subroutine amg_d_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
-           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
-      implicit none
-      type(psb_dspmat_type), intent(inout)    :: a
-      type(psb_desc_type), intent(inout)       :: desc_a
-      integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-      type(amg_dml_parms), intent(inout)      :: parms
-      type(psb_ldspmat_type), intent(inout)   :: t_prol
-      type(psb_dspmat_type), intent(inout)    :: op_prol,ac, op_restr
-      type(psb_desc_type), intent(out)          :: desc_ac
-      integer(psb_ipk_), intent(out)          :: info
-    end subroutine amg_d_parmatch_spmm_bld_ov
-  end interface
-
-  interface
-    subroutine amg_d_parmatch_spmm_bld_inner(a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
-           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data,&
-           & psb_d_csr_sparse_mat, psb_ld_csr_sparse_mat
-      implicit none
-      type(psb_d_csr_sparse_mat), intent(inout) :: a
-      type(psb_desc_type), intent(inout)          :: desc_a
-      integer(psb_lpk_), intent(inout)          :: ilaggr(:), nlaggr(:)
-      type(amg_dml_parms), intent(inout)        :: parms
-      type(psb_ldspmat_type), intent(inout)     :: t_prol
-      type(psb_dspmat_type), intent(inout)      :: op_prol,ac, op_restr
-      type(psb_desc_type), intent(out)          :: desc_ac
-      integer(psb_ipk_), intent(out)            :: info
-    end subroutine amg_d_parmatch_spmm_bld_inner
-  end interface
-
-  private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels
-
-contains
-
-  subroutine amg_d_bld_default_w(ag,nr)
-    use psb_realloc_mod
-    implicit none
-    class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
-    integer(psb_ipk_), intent(in) :: nr
-    integer(psb_ipk_) :: info
-    call psb_realloc(nr,ag%w,info)
-    if (info /= psb_success_) return
-    ag%w = done
-    !call ag%set_c_default_w()
-  end subroutine amg_d_bld_default_w
-
-  subroutine amg_d_set_prm_c_default_w(ag)
-    use psb_realloc_mod
-    use iso_c_binding
-    implicit none
-    class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
-    integer(psb_ipk_) :: info
-
-    !write(0,*) 'prm_c_deafult_w '
-    call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
-
-  end subroutine amg_d_set_prm_c_default_w
-
-  subroutine amg_d_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
-    use psb_realloc_mod
-    implicit none
-    class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
-    integer(psb_lpk_), intent(in)  :: ilaggr(:)
-    real(psb_dpk_), intent(in)     :: valaggr(:)
-    integer(psb_ipk_), intent(in)  :: nx
-
-    integer(psb_ipk_) :: info,i,j
-
-    ! The vector was already fixed in the call to BCMatch.
-    !write(0,*) 'Executing bld_wnxt ',nx
-    call psb_realloc(nx,ag%w_nxt,info)
-
-  end subroutine amg_d_parmatch_bld_wnxt
-
-  function amg_d_parmatch_aggregator_fmt() result(val)
-    implicit none
-    character(len=32)  :: val
-
-    val = "Parallel Matching aggregation"
-  end function amg_d_parmatch_aggregator_fmt
-
-  function amg_d_parmatch_aggregator_xt_desc() result(val)
-    implicit none
-    logical  :: val
-
-    val = .true.
-  end function amg_d_parmatch_aggregator_xt_desc
-
-  function amg_d_parmatch_aggregator_sizeof(ag) result(val)
-    use psb_realloc_mod
-    implicit none
-    class(amg_d_parmatch_aggregator_type), intent(in)  :: ag
-    integer(psb_epk_)  :: val
-
-    val = 4
-    val = val + psb_size(ag%w) + psb_size(ag%w_nxt)
-    if (allocated(ag%ac))      val = val + ag%ac%sizeof()
-    if (allocated(ag%base_a))  val = val + ag%base_a%sizeof()
-    if (allocated(ag%prol))    val = val + ag%prol%sizeof()
-    if (allocated(ag%restr))   val = val + ag%restr%sizeof()
-    if (allocated(ag%desc_ac)) val = val + ag%desc_ac%sizeof()
-    if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
-    if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
-
-  end function amg_d_parmatch_aggregator_sizeof
-
-  subroutine  amg_d_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
-    implicit none
-    class(amg_d_parmatch_aggregator_type), intent(in) :: ag
-    type(amg_dml_parms), intent(in)   :: parms
-    integer(psb_ipk_), intent(in)  :: iout
-    integer(psb_ipk_), intent(out) :: info
-    character(len=*), intent(in), optional  :: prefix
-    character(1024)    :: prefix_
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
-    write(iout,*) trim(prefix_),' ','   Number of matching  sweeps: ',ag%n_sweeps
-    write(iout,*) trim(prefix_),' ','   Matching algorithm         : MatchBoxP (PREIS)'
-    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info,prefix=prefix)
-
-    return
-  end subroutine amg_d_parmatch_aggregator_descr
-
-  function is_legal_malg(alg) result(val)
-    logical :: val
-    integer(psb_ipk_) :: alg
-
-    val = (0==alg)
-  end function is_legal_malg
-
-  function is_legal_csize(csize) result(val)
-    logical :: val
-    integer(psb_ipk_) :: csize
-
-    val = ((-1==csize).or.(csize >0))
-  end function is_legal_csize
-
-  function is_legal_nsweeps(nsw) result(val)
-    logical :: val
-    integer(psb_ipk_) :: nsw
-
-    val = (1<=nsw)
-  end function is_legal_nsweeps
-
-  function is_legal_nlevels(nlv) result(val)
-    logical :: val
-    integer(psb_ipk_) :: nlv
-
-    val = (1<=nlv)
-  end function is_legal_nlevels
-
-
-  subroutine  amg_d_parmatch_aggregator_update_next(ag,agnext,info)
-    use psb_realloc_mod
-    implicit none
-    class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
-    class(amg_d_base_aggregator_type), target, intent(inout) :: agnext
-    integer(psb_ipk_), intent(out)       :: info
-
-    !
-    !
-    select type(agnext)
-    class is (amg_d_parmatch_aggregator_type)
-      if (.not.is_legal_malg(agnext%matching_alg)) &
-           & agnext%matching_alg = ag%matching_alg
-      if (.not.is_legal_nsweeps(agnext%n_sweeps))&
-           & agnext%n_sweeps     = ag%n_sweeps
-!!$      if (.not.is_legal_csize(agnext%max_csize))&
-!!$           & agnext%max_csize    = ag%max_csize
-!!$      if (.not.is_legal_nlevels(agnext%max_nlevels))&
-!!$           & agnext%max_nlevels  = ag%max_nlevels
-      ! Is this going to generate shallow copies/memory leaks/double frees?
-      ! To be investigated further.
-      call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
-      call agnext%set_c_default_w()
-      if (ag%unsmoothed_hierarchy) then
-        agnext%unsmoothed_hierarchy = .true.
-        call move_alloc(ag%rwdesc,agnext%base_desc)
-        call move_alloc(ag%rwa,agnext%base_a)
-      end if
-
-    class default
-      ! What should we do here?
-    end select
-    info = 0
-  end subroutine amg_d_parmatch_aggregator_update_next
-
-  subroutine amg_d_parmatch_aggr_csetc(ag,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
-    character(len=*), intent(in)                  :: what
-    character(len=*), intent(in)                 :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act, iwhat
-    character(len=20)  :: name='d_parmatch_aggr_cseti'
-    info = psb_success_
-
-    ! For now we ignore IDX
-
-    select case(psb_toupper(trim(what)))
-    case('PRMC_REPRODUCIBLE_MATCHING')
-      select case(psb_toupper(trim(val)))
-      case('F','FALSE')
-        ag%reproducible_matching = .false.
-      case('REPRODUCIBLE','TRUE','T')
-        ag%reproducible_matching =.true.
-      end select
-    case('PRMC_NEED_SYMMETRIZE')
-      select case(psb_toupper(trim(val)))
-      case('FALSE','F')
-        ag%need_symmetrize = .false.
-      case('SYMMETRIZE','TRUE','T')
-        ag%need_symmetrize =.true.
-      end select
-    case('PRMC_UNSMOOTHED_HIERARCHY')
-      select case(psb_toupper(trim(val)))
-      case('F','FALSE')
-        ag%unsmoothed_hierarchy = .false.
-      case('T','TRUE')
-        ag%unsmoothed_hierarchy =.true.
-      end select
-    case default
-      ! Do nothing
-    end select
-    return
-  end subroutine amg_d_parmatch_aggr_csetc
-
-  subroutine amg_d_parmatch_aggr_cseti(ag,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
-    character(len=*), intent(in)                  :: what
-    integer(psb_ipk_), intent(in)                 :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act, iwhat
-    character(len=20)  :: name='d_parmatch_aggr_cseti'
-    info = psb_success_
-
-    ! For now we ignore IDX
-
-    select case(psb_toupper(trim(what)))
-    case('PRMC_MATCH_ALG')
-      ag%matching_alg=val
-    case('PRMC_SWEEPS')
-      ag%n_sweeps=val
-    case('AGGR_SIZE')
-      ag%orig_aggr_size = val
-      ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
-    case('PRMC_W_SIZE')
-      call ag%bld_default_w(val)
-    case('PRMC_REPRODUCIBLE_MATCHING')
-      ag%reproducible_matching = (val == 1)
-    case('PRMC_NEED_SYMMETRIZE')
-      ag%need_symmetrize = (val == 1)
-    case('PRMC_UNSMOOTHED_HIERARCHY')
-      ag%unsmoothed_hierarchy = (val == 1)
-    case default
-      ! Do nothing
-    end select
-    return
-  end subroutine amg_d_parmatch_aggr_cseti
-
-  subroutine amg_d_parmatch_aggr_set_default(ag)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
-    character(len=20)  :: name='d_parmatch_aggr_set_default'
-    call ag%amg_d_base_aggregator_type%default()
-    ag%matching_alg  = 0
-    ag%n_sweeps      = 1
-    ag%jacobi_sweeps = 0
-!!$    ag%max_nlevels   = 36
-!!$    ag%max_csize     = -1
-    !
-    ! Apparently BootCMatch works better
-    ! by keeping all entries
-    !
-    ag%do_clean_zeros = .false.
-
-    return
-
-  end subroutine amg_d_parmatch_aggr_set_default
-
-  subroutine  amg_d_parmatch_aggregator_free(ag,info)
-    use iso_c_binding
-    implicit none
-    class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
-    integer(psb_ipk_), intent(out)       :: info
-
-    info = 0
-    if ((info == 0).and.allocated(ag%w)) deallocate(ag%w,stat=info)
-    if ((info == 0).and.allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info)
-    if ((info == 0).and.allocated(ag%prol)) then
-      call ag%prol%free(); deallocate(ag%prol,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%restr)) then
-      call ag%restr%free(); deallocate(ag%restr,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%ac)) then
-      call ag%ac%free(); deallocate(ag%ac,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%base_a)) then
-      call ag%base_a%free(); deallocate(ag%base_a,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%rwa)) then
-      call ag%rwa%free(); deallocate(ag%rwa,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%desc_ac)) then
-      call ag%desc_ac%free(info); deallocate(ag%desc_ac,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%desc_ax)) then
-      call ag%desc_ax%free(info); deallocate(ag%desc_ax,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%base_desc)) then
-      call ag%base_desc%free(info); deallocate(ag%base_desc,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%rwdesc)) then
-      call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
-    end if
-
-  end subroutine amg_d_parmatch_aggregator_free
-
-  subroutine  amg_d_parmatch_aggregator_clone(ag,agnext,info)
-    implicit none
-    class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
-    class(amg_d_base_aggregator_type), allocatable, intent(inout) :: agnext
-    integer(psb_ipk_), intent(out)       :: info
-
-    info = 0
-    if (allocated(agnext)) then
-      call agnext%free(info)
-      if (info == 0) deallocate(agnext,stat=info)
-    end if
-    if (info /= 0) return
-    allocate(agnext,source=ag,stat=info)
-    select type(agnext)
-    class is (amg_d_parmatch_aggregator_type)
-      call agnext%set_c_default_w()
-    class default
-      ! Should never ever get here
-      info = -1
-    end select
-  end subroutine amg_d_parmatch_aggregator_clone
-
-  subroutine  amg_d_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
-       & op_restr,op_prol,map,info)
-    use psb_base_mod
-    implicit none
-    class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
-    type(psb_desc_type), intent(in), target :: desc_a, desc_ac
-    integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-    type(psb_dspmat_type), intent(inout)   :: op_prol, op_restr
-    type(psb_dlinmap_type), intent(out)     :: map
-    integer(psb_ipk_), intent(out)          :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20) :: name='d_parmatch_aggregator_bld_map'
-
-    call psb_erractionsave(err_act)
-    !
-    ! Copy the prolongation/restriction matrices into the descriptor map.
-    !  op_restr => PR^T   i.e. restriction  operator
-    !  op_prol => PR     i.e. prolongation operator
-    !
-    !  For parmatch have an explicit copy of the descriptors
-    !
-    if (allocated(ag%desc_ax)) then
-!!$      write(0,*) 'Building linmap with ag%desc_ax ',ag%desc_ax%get_local_rows(),ag%desc_ax%get_local_cols(),&
-!!$           & desc_ac%get_local_rows(),desc_ac%get_local_cols()
-      map = psb_linmap(psb_map_gen_linear_,ag%desc_ax,&
-           & desc_ac,op_restr,op_prol,ilaggr,nlaggr)
-    else
-      map = psb_linmap(psb_map_gen_linear_,desc_a,&
-           & desc_ac,op_restr,op_prol,ilaggr,nlaggr)
-    end if
-    if(info /= psb_success_) then
-      call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
-      goto 9999
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-
-    return
-  end subroutine amg_d_parmatch_aggregator_bld_map
-#endif
-end module amg_d_parmatch_aggregator_mod

amgprec/amg_d_poly_coeff_mod.f90

@@ -1,548 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Daniela di Serafino
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-!
-! File: amg_d_poly_smoother_mod.f90
-!
-! Module: amg_d_poly_smoother_mod
-!
-!  This module defines:
-!    the amg_d_poly_smoother_type data structure containing the
-!    smoother for a Jacobi/block Jacobi smoother.
-!  The smoother stores in ND the block off-diagonal matrix.
-!  One special case is treated separately, when the solver is DIAG or L1-DIAG
-!  then the ND is the entire off-diagonal part of the matrix (including the
-!  main diagonal block), so that it becomes possible to implement
-!  a pure Jacobi or L1-Jacobi global solver.
-!
-module amg_d_poly_coeff_mod
-  use psb_base_mod
-
-  real(psb_dpk_), parameter :: amg_d_poly_a_vect(30) = [ &
-       & 0.3333333333333333_psb_dpk_, &
-       & 0.1805359927403007_psb_dpk_, &
-       & 0.1159278464862213_psb_dpk_, &
-       & 0.0820780659590383_psb_dpk_, &
-       & 0.0618496002413377_psb_dpk_, &
-       & 0.0486605823426062_psb_dpk_, &
-       & 0.0395132986024057_psb_dpk_, &
-       & 0.0328701017544880_psb_dpk_, &
-       & 0.0278702862721800_psb_dpk_, &
-       & 0.0239987409600620_psb_dpk_, &
-       & 0.0209304400432259_psb_dpk_, &
-       & 0.0184513099045066_psb_dpk_, &
-       & 0.0164152586042591_psb_dpk_, &
-       & 0.0147195638076874_psb_dpk_, &
-       & 0.0132901324757843_psb_dpk_, &
-       & 0.0120723317737698_psb_dpk_, &
-       & 0.0110250964606384_psb_dpk_, &
-       & 0.0101170330064859_psb_dpk_, &
-       & 0.0093237789039835_psb_dpk_, &
-       & 0.0086261728849515_psb_dpk_, &
-       & 0.0080089618703679_psb_dpk_, &
-       & 0.0074598709610601_psb_dpk_, &
-       & 0.0069689238144320_psb_dpk_, &
-       & 0.0065279387776372_psb_dpk_, &
-       & 0.0061301503808627_psb_dpk_, &
-       & 0.0057699215598864_psb_dpk_, &
-       & 0.0054425224281914_psb_dpk_, &
-       & 0.0051439584672521_psb_dpk_, &
-       & 0.0048708358327268_psb_dpk_, &
-       & 0.0046202548314912_psb_dpk_ ];
-  
-  real(psb_dpk_), parameter :: amg_d_poly_beta_vect(900) = [ &
-       & 1.1250000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0238728757031315_psb_dpk_, 1.2640890537108553_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0084254478202830_psb_dpk_, 1.0886783920873087_psb_dpk_, &
-       & 1.3375312590961856_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0039131042728535_psb_dpk_, 1.0403581118859304_psb_dpk_, &
-       & 1.1486349854625493_psb_dpk_, 1.3826886924100055_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0021293014616472_psb_dpk_, 1.0217371154926094_psb_dpk_, &
-       & 1.0787243319260302_psb_dpk_, 1.1981006529266300_psb_dpk_, &
-       & 1.4132254279168215_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0012851725594023_psb_dpk_, 1.0130429303523338_psb_dpk_, &
-       & 1.0467821512411335_psb_dpk_, 1.1161648941967548_psb_dpk_, &
-       & 1.2382902021844453_psb_dpk_, 1.4352429710674484_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0008346439791242_psb_dpk_, 1.0084394943012289_psb_dpk_, &
-       & 1.0300870776871385_psb_dpk_, 1.0740838409200377_psb_dpk_, &
-       & 1.1503618670736642_psb_dpk_, 1.2711647404613990_psb_dpk_, &
-       & 1.4518665864936395_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0005724663119766_psb_dpk_, 1.0057742766241562_psb_dpk_, &
-       & 1.0205018792294143_psb_dpk_, 1.0501980344456543_psb_dpk_, &
-       & 1.1011557298494106_psb_dpk_, 1.1808604280685657_psb_dpk_, &
-       & 1.2983858538257604_psb_dpk_, 1.4648607315109978_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0004096007283281_psb_dpk_, 1.0041243950610661_psb_dpk_, &
-       & 1.0146021214826659_psb_dpk_, 1.0356111362667175_psb_dpk_, &
-       & 1.0713997252919425_psb_dpk_, 1.1268827371096291_psb_dpk_, &
-       & 1.2078521914072933_psb_dpk_, 1.3212193071674674_psb_dpk_, &
-       & 1.4752964282069962_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0003031222965291_psb_dpk_, 1.0030484066079688_psb_dpk_, &
-       & 1.0107702271538761_psb_dpk_, 1.0261901159764004_psb_dpk_, &
-       & 1.0523172493375519_psb_dpk_, 1.0925574320754976_psb_dpk_, &
-       & 1.1508337666397197_psb_dpk_, 1.2317225087089441_psb_dpk_, &
-       & 1.3406080202445980_psb_dpk_, 1.4838612440701109_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0002305859520939_psb_dpk_, 1.0023167502402850_psb_dpk_, &
-       & 1.0081724539630488_psb_dpk_, 1.0198298656634219_psb_dpk_, &
-       & 1.0395021023532465_psb_dpk_, 1.0696504270054137_psb_dpk_, &
-       & 1.1130575429574259_psb_dpk_, 1.1729087627556418_psb_dpk_, &
-       & 1.2528830057679230_psb_dpk_, 1.3572557991951903_psb_dpk_, &
-       & 1.4910167256413891_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0001794720082837_psb_dpk_, 1.0018018913961957_psb_dpk_, &
-       & 1.0063486190730762_psb_dpk_, 1.0153786456630600_psb_dpk_, &
-       & 1.0305694283076039_psb_dpk_, 1.0537601969394355_psb_dpk_, &
-       & 1.0869986259207296_psb_dpk_, 1.1325918309791341_psb_dpk_, &
-       & 1.1931627335817252_psb_dpk_, 1.2717129367511055_psb_dpk_, &
-       & 1.3716933796979953_psb_dpk_, 1.4970841857556243_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0001424192155957_psb_dpk_, 1.0014290693262966_psb_dpk_, &
-       & 1.0050302898629815_psb_dpk_, 1.0121691051849540_psb_dpk_, &
-       & 1.0241487434279255_psb_dpk_, 1.0423815888082042_psb_dpk_, &
-       & 1.0684200812870084_psb_dpk_, 1.1039901093675994_psb_dpk_, &
-       & 1.1510274824264566_psb_dpk_, 1.2117181191012512_psb_dpk_, &
-       & 1.2885426486512805_psb_dpk_, 1.3843261938099158_psb_dpk_, &
-       & 1.5022941875736890_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0001149053826193_psb_dpk_, 1.0011524637691460_psb_dpk_, &
-       & 1.0040535733326481_psb_dpk_, 1.0097959057315313_psb_dpk_, &
-       & 1.0194130047299461_psb_dpk_, 1.0340142503543679_psb_dpk_, &
-       & 1.0548059960662932_psb_dpk_, 1.0831142030181304_psb_dpk_, &
-       & 1.1204089166089239_psb_dpk_, 1.1683309565544606_psb_dpk_, &
-       & 1.2287212228823874_psb_dpk_, 1.3036530570781755_psb_dpk_, &
-       & 1.3954681405367855_psb_dpk_, 1.5068164620958386_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000940475075257_psb_dpk_, 1.0009429169634352_psb_dpk_, &
-       & 1.0033144905644482_psb_dpk_, 1.0080029483381612_psb_dpk_, &
-       & 1.0158423625914039_psb_dpk_, 1.0277208331770495_psb_dpk_, &
-       & 1.0445953542283146_psb_dpk_, 1.0675076120612534_psb_dpk_, &
-       & 1.0976009254588965_psb_dpk_, 1.1361385536615733_psb_dpk_, &
-       & 1.1845236142623621_psb_dpk_, 1.2443208730447588_psb_dpk_, &
-       & 1.3172806908339272_psb_dpk_, 1.4053654389356023_psb_dpk_, &
-       & 1.5107787250184523_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000779482817921_psb_dpk_, 1.0007812684725339_psb_dpk_, &
-       & 1.0027448797440124_psb_dpk_, 1.0066229101701514_psb_dpk_, &
-       & 1.0130985883697137_psb_dpk_, 1.0228944832933697_psb_dpk_, &
-       & 1.0367832140998394_psb_dpk_, 1.0555987571989653_psb_dpk_, &
-       & 1.0802484840556024_psb_dpk_, 1.1117260713149764_psb_dpk_, &
-       & 1.1511254343107276_psb_dpk_, 1.1996558461497355_psb_dpk_, &
-       & 1.2586584174494597_psb_dpk_, 1.3296241265666493_psb_dpk_, &
-       & 1.4142136069557629_psb_dpk_, 1.5142789173034623_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000653242183546_psb_dpk_, 1.0006545722939437_psb_dpk_, &
-       & 1.0022987777448662_psb_dpk_, 1.0055432691173583_psb_dpk_, &
-       & 1.0109550075016893_psb_dpk_, 1.0191301541168694_psb_dpk_, &
-       & 1.0307019481191382_psb_dpk_, 1.0463489778000818_psb_dpk_, &
-       & 1.0668039321569163_psb_dpk_, 1.0928629244731740_psb_dpk_, &
-       & 1.1253954850882542_psb_dpk_, 1.1653553270075827_psb_dpk_, &
-       & 1.2137919954743157_psb_dpk_, 1.2718635211544003_psb_dpk_, &
-       & 1.3408502062615073_psb_dpk_, 1.4221696838526183_psb_dpk_, &
-       & 1.5173934027630227_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000552858792859_psb_dpk_, 1.0005538659610900_psb_dpk_, &
-       & 1.0019444166743086_psb_dpk_, 1.0046864301776393_psb_dpk_, &
-       & 1.0092557508630260_psb_dpk_, 1.0161502674772371_psb_dpk_, &
-       & 1.0258958148322650_psb_dpk_, 1.0390523408953256_psb_dpk_, &
-       & 1.0562203973533295_psb_dpk_, 1.0780480145522537_psb_dpk_, &
-       & 1.1052380250439366_psb_dpk_, 1.1385559038570177_psb_dpk_, &
-       & 1.1788381980793483_psb_dpk_, 1.2270016234308427_psb_dpk_, &
-       & 1.2840529112630572_psb_dpk_, 1.3510994958895055_psb_dpk_, &
-       & 1.4293611393851839_psb_dpk_, 1.5201825990516680_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000472036358790_psb_dpk_, 1.0004728102642675_psb_dpk_, &
-       & 1.0016593577469159_psb_dpk_, 1.0039976891368516_psb_dpk_, &
-       & 1.0078911941833455_psb_dpk_, 1.0137601583069535_psb_dpk_, &
-       & 1.0220462561721002_psb_dpk_, 1.0332172281153209_psb_dpk_, &
-       & 1.0477717791157513_psb_dpk_, 1.0662447417325256_psb_dpk_, &
-       & 1.0892125464929936_psb_dpk_, 1.1172990456131733_psb_dpk_, &
-       & 1.1511817386833911_psb_dpk_, 1.1915984520803475_psb_dpk_, &
-       & 1.2393545273929878_psb_dpk_, 1.2953305781018039_psb_dpk_, &
-       & 1.3604908781568688_psb_dpk_, 1.4358924509939206_psb_dpk_, &
-       & 1.5226949329440265_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000406232569254_psb_dpk_, 1.0004068351374691_psb_dpk_, &
-       & 1.0014274431564170_psb_dpk_, 1.0034377175807407_psb_dpk_, &
-       & 1.0067826854070978_psb_dpk_, 1.0118204999571436_psb_dpk_, &
-       & 1.0189259121271075_psb_dpk_, 1.0284938700470616_psb_dpk_, &
-       & 1.0409432748132981_psb_dpk_, 1.0567209210598594_psb_dpk_, &
-       & 1.0763056524407055_psb_dpk_, 1.1002127636100871_psb_dpk_, &
-       & 1.1289986820268283_psb_dpk_, 1.1632659648787138_psb_dpk_, &
-       & 1.2036686486408621_psb_dpk_, 1.2509179912601627_psb_dpk_, &
-       & 1.3057886497146727_psb_dpk_, 1.3691253387497200_psb_dpk_, &
-       & 1.4418500199624611_psb_dpk_, 1.5249696741164267_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000352114440929_psb_dpk_, 1.0003525892395289_psb_dpk_, &
-       & 1.0012368357172980_psb_dpk_, 1.0029777430511673_psb_dpk_, &
-       & 1.0058727830027672_psb_dpk_, 1.0102297507781717_psb_dpk_, &
-       & 1.0163694815733537_psb_dpk_, 1.0246286588536329_psb_dpk_, &
-       & 1.0353627340015590_psb_dpk_, 1.0489489776835172_psb_dpk_, &
-       & 1.0657896841306789_psb_dpk_, 1.0863155505114006_psb_dpk_, &
-       & 1.1109892546943501_psb_dpk_, 1.1403092559728156_psb_dpk_, &
-       & 1.1748138447471401_psb_dpk_, 1.2150854687543668_psb_dpk_, &
-       & 1.2617553651999671_psb_dpk_, 1.3155085300984379_psb_dpk_, &
-       & 1.3770890582780710_psb_dpk_, 1.4473058898645985_psb_dpk_, &
-       & 1.5270390016420912_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000307198714835_psb_dpk_, 1.0003075769178242_psb_dpk_, &
-       & 1.0010787281022711_psb_dpk_, 1.0025963829693492_psb_dpk_, &
-       & 1.0051188625231162_psb_dpk_, 1.0089126974249720_psb_dpk_, &
-       & 1.0142547789760521_psb_dpk_, 1.0214345766593154_psb_dpk_, &
-       & 1.0307564364069204_psb_dpk_, 1.0425419742322541_psb_dpk_, &
-       & 1.0571325804249445_psb_dpk_, 1.0748920501551993_psb_dpk_, &
-       & 1.0962093570737961_psb_dpk_, 1.1215015873309027_psb_dpk_, &
-       & 1.1512170523743910_psb_dpk_, 1.1858385999327761_psb_dpk_, &
-       & 1.2258871437439198_psb_dpk_, 1.2719254338660289_psb_dpk_, &
-       & 1.3245620908078453_psb_dpk_, 1.3844559282498121_psb_dpk_, &
-       & 1.4523205908039656_psb_dpk_, 1.5289295350887884_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000269609460124_psb_dpk_, 1.0002699137181752_psb_dpk_, &
-       & 1.0009464748475532_psb_dpk_, 1.0022775198638552_psb_dpk_, &
-       & 1.0044888368184179_psb_dpk_, 1.0078128087804721_psb_dpk_, &
-       & 1.0124901352066715_psb_dpk_, 1.0187716022931539_psb_dpk_, &
-       & 1.0269199126829005_psb_dpk_, 1.0372115852204526_psb_dpk_, &
-       & 1.0499389358225151_psb_dpk_, 1.0654121509688057_psb_dpk_, &
-       & 1.0839614658147161_psb_dpk_, 1.1059394594887115_psb_dpk_, &
-       & 1.1317234807654135_psb_dpk_, 1.1617182180038959_psb_dpk_, &
-       & 1.1963584280123116_psb_dpk_, 1.2361118393501820_psb_dpk_, &
-       & 1.2814822465106404_psb_dpk_, 1.3330128124440397_psb_dpk_, &
-       & 1.3912895979940381_psb_dpk_, 1.4569453380258381_psb_dpk_, &
-       & 1.5306634853375161_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000237911597230_psb_dpk_, 1.0002381585998457_psb_dpk_, &
-       & 1.0008349974382460_psb_dpk_, 1.0020088476285827_psb_dpk_, &
-       & 1.0039582343156432_psb_dpk_, 1.0068870298152559_psb_dpk_, &
-       & 1.0110058445931565_psb_dpk_, 1.0165334547611182_psb_dpk_, &
-       & 1.0236982737890488_psb_dpk_, 1.0327398763510158_psb_dpk_, &
-       & 1.0439105824804926_psb_dpk_, 1.0574771105088172_psb_dpk_, &
-       & 1.0737223076000839_psb_dpk_, 1.0929469670793606_psb_dpk_, &
-       & 1.1154717421787756_psb_dpk_, 1.1416391663018148_psb_dpk_, &
-       & 1.1718157904303341_psb_dpk_, 1.2063944488757254_psb_dpk_, &
-       & 1.2457966652063013_psb_dpk_, 1.2904752108716941_psb_dpk_, &
-       & 1.3409168297942540_psb_dpk_, 1.3976451430108305_psb_dpk_, &
-       & 1.4612237483301715_psb_dpk_, 1.5322595309246121_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000210994601235_psb_dpk_, 1.0002111968041199_psb_dpk_, &
-       & 1.0007403694573151_psb_dpk_, 1.0017808593384865_psb_dpk_, &
-       & 1.0035081686576977_psb_dpk_, 1.0061021720448531_psb_dpk_, &
-       & 1.0097482505685551_psb_dpk_, 1.0146384533048582_psb_dpk_, &
-       & 1.0209726922414943_psb_dpk_, 1.0289599764553270_psb_dpk_, &
-       & 1.0388196916802268_psb_dpk_, 1.0507829315895938_psb_dpk_, &
-       & 1.0650938873538003_psb_dpk_, 1.0820113022982043_psb_dpk_, &
-       & 1.1018099987843295_psb_dpk_, 1.1247824847650900_psb_dpk_, &
-       & 1.1512406478277994_psb_dpk_, 1.1815175449359154_psb_dpk_, &
-       & 1.2159692965153148_psb_dpk_, 1.2549770940040335_psb_dpk_, &
-       & 1.2989493304988182_psb_dpk_, 1.3483238646890843_psb_dpk_, &
-       & 1.4035704288718982_psb_dpk_, 1.4651931924923849_psb_dpk_, &
-       & 1.5337334933563860_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000187989989242_psb_dpk_, 1.0001881567984481_psb_dpk_, &
-       & 1.0006595227084085_psb_dpk_, 1.0015861311895899_psb_dpk_, &
-       & 1.0031239047778964_psb_dpk_, 1.0054323694760092_psb_dpk_, &
-       & 1.0086755868504005_psb_dpk_, 1.0130231071421940_psb_dpk_, &
-       & 1.0186509477893992_psb_dpk_, 1.0257426018654052_psb_dpk_, &
-       & 1.0344900810652515_psb_dpk_, 1.0450949980170887_psb_dpk_, &
-       & 1.0577696928624343_psb_dpk_, 1.0727384092356933_psb_dpk_, &
-       & 1.0902385249817814_psb_dpk_, 1.1105218431816117_psb_dpk_, &
-       & 1.1338559493090710_psb_dpk_, 1.1605256406217599_psb_dpk_, &
-       & 1.1908344341913664_psb_dpk_, 1.2251061603103259_psb_dpk_, &
-       & 1.2636866483695495_psb_dpk_, 1.3069455126904677_psb_dpk_, &
-       & 1.3552780462128098_psb_dpk_, 1.4091072303921326_psb_dpk_, &
-       & 1.4688858701459975_psb_dpk_, 1.5350988632115488_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000168211938973_psb_dpk_, 1.0001683505351420_psb_dpk_, &
-       & 1.0005900360142315_psb_dpk_, 1.0014188084960041_psb_dpk_, &
-       & 1.0027938311393803_psb_dpk_, 1.0048572584314193_psb_dpk_, &
-       & 1.0077550080990554_psb_dpk_, 1.0116375492127350_psb_dpk_, &
-       & 1.0166607098595459_psb_dpk_, 1.0229865078405374_psb_dpk_, &
-       & 1.0307840079371537_psb_dpk_, 1.0402302093961155_psb_dpk_, &
-       & 1.0515109674005423_psb_dpk_, 1.0648219524284319_psb_dpk_, &
-       & 1.0803696515480321_psb_dpk_, 1.0983724158638981_psb_dpk_, &
-       & 1.1190615585080472_psb_dpk_, 1.1426825077681895_psb_dpk_, &
-       & 1.1694960201606786_psb_dpk_, 1.1997794584895700_psb_dpk_, &
-       & 1.2338281401870808_psb_dpk_, 1.2719567615042522_psb_dpk_, &
-       & 1.3145009034164739_psb_dpk_, 1.3618186254259919_psb_dpk_, &
-       & 1.4142921537855777_psb_dpk_, 1.4723296710339275_psb_dpk_, &
-       & 1.5363672141264497_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000151113991291_psb_dpk_, 1.0001512299115287_psb_dpk_, &
-       & 1.0005299814085029_psb_dpk_, 1.0012742317597600_psb_dpk_, &
-       & 1.0025087130476142_psb_dpk_, 1.0043606572645858_psb_dpk_, &
-       & 1.0069604400315522_psb_dpk_, 1.0104422369100252_psb_dpk_, &
-       & 1.0149446949285030_psb_dpk_, 1.0206116219981500_psb_dpk_, &
-       & 1.0275926969588451_psb_dpk_, 1.0360442030716124_psb_dpk_, &
-       & 1.0461297878595799_psb_dpk_, 1.0580212522952626_psb_dpk_, &
-       & 1.0718993724396861_psb_dpk_, 1.0879547567564958_psb_dpk_, &
-       & 1.1063887424550545_psb_dpk_, 1.1274143343577541_psb_dpk_, &
-       & 1.1512571899424711_psb_dpk_, 1.1781566543781672_psb_dpk_, &
-       & 1.2083668495540898_psb_dpk_, 1.2421578212983135_psb_dpk_, &
-       & 1.2798167491932815_psb_dpk_, 1.3216492236219661_psb_dpk_, &
-       & 1.3679805949228399_psb_dpk_, 1.4191573997915068_psb_dpk_, &
-       & 1.4755488703473389_psb_dpk_, 1.5375485315807513_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000136257096588_psb_dpk_, 1.0001363546506836_psb_dpk_, &
-       & 1.0004778107488095_psb_dpk_, 1.0011486612681773_psb_dpk_, &
-       & 1.0022611433613271_psb_dpk_, 1.0039295964948667_psb_dpk_, &
-       & 1.0062710027404669_psb_dpk_, 1.0094055369479136_psb_dpk_, &
-       & 1.0134571288503909_psb_dpk_, 1.0185540391932908_psb_dpk_, &
-       & 1.0248294520252528_psb_dpk_, 1.0324220853457433_psb_dpk_, &
-       & 1.0414768223656390_psb_dpk_, 1.0521453657079123_psb_dpk_, &
-       & 1.0645869169533493_psb_dpk_, 1.0789688840227822_psb_dpk_, &
-       & 1.0954676189818162_psb_dpk_, 1.1142691889576817_psb_dpk_, &
-       & 1.1355701829701565_psb_dpk_, 1.1595785576006521_psb_dpk_, &
-       & 1.1865145245551894_psb_dpk_, 1.2166114833191515_psb_dpk_, &
-       & 1.2501170022543431_psb_dpk_, 1.2872938516530203_psb_dpk_, &
-       & 1.3284210924391027_psb_dpk_, 1.3737952243949607_psb_dpk_, &
-       & 1.4237313979931023_psb_dpk_, 1.4785646941265451_psb_dpk_, &
-       & 1.5386514762605854_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000123285767939_psb_dpk_, 1.0001233683396147_psb_dpk_, &
-       & 1.0004322711781202_psb_dpk_, 1.0010390719329101_psb_dpk_, &
-       & 1.0020451337350940_psb_dpk_, 1.0035535979966428_psb_dpk_, &
-       & 1.0056698406248343_psb_dpk_, 1.0085019360540697_psb_dpk_, &
-       & 1.0121611307132341_psb_dpk_, 1.0167623275769953_psb_dpk_, &
-       & 1.0224245834847208_psb_dpk_, 1.0292716209515502_psb_dpk_, &
-       & 1.0374323562422998_psb_dpk_, 1.0470414455308106_psb_dpk_, &
-       & 1.0582398510249318_psb_dpk_, 1.0711754290010183_psb_dpk_, &
-       & 1.0860035417614331_psb_dpk_, 1.1028876956049132_psb_dpk_, &
-       & 1.1220002069820316_psb_dpk_, 1.1435228990979547_psb_dpk_, &
-       & 1.1676478313209715_psb_dpk_, 1.1945780638597872_psb_dpk_, &
-       & 1.2245284602839432_psb_dpk_, 1.2577265305821996_psb_dpk_, &
-       & 1.2944133175813315_psb_dpk_, 1.3348443296857557_psb_dpk_, &
-       & 1.3792905230439911_psb_dpk_, 1.4280393364047606_psb_dpk_, &
-       & 1.4813957820911738_psb_dpk_, 1.5396835966986973_psb_dpk_ ]
-
-
-
-
-!!$  [1.1250000000000000_psb_dpk_, 0.0_psb_dpk_, 0.0_psb_dpk__psb_dpk_,,&
-!!$       & 1.0238728757031315_psb_dpk_, 1.2640890537108553_psb_dpk_,  0.0_psb_dpk_,&
-!!$       & 1.0084254478202830_psb_dpk_, 1.0886783920873087_psb_dpk_, 1.3375312590961856_psb_dpk_]
-
-  real(psb_dpk_), parameter  :: amg_d_poly_beta_mat(30,30)=reshape(amg_d_poly_beta_vect,[30,30])
-
-end module amg_d_poly_coeff_mod

amgprec/amg_d_poly_smoother.f90

@@ -1,374 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Daniela di Serafino
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-!
-! File: amg_d_poly_smoother_mod.f90
-!
-! Module: amg_d_poly_smoother_mod
-!
-!  This module defines:
-!    the amg_d_poly_smoother_type data structure containing the
-!    smoother for a Jacobi/block Jacobi smoother.
-!  The smoother stores in ND the block off-diagonal matrix.
-!  One special case is treated separately, when the solver is DIAG or L1-DIAG
-!  then the ND is the entire off-diagonal part of the matrix (including the
-!  main diagonal block), so that it becomes possible to implement
-!  a pure Jacobi or L1-Jacobi global solver.
-!
-module amg_d_poly_smoother
-  use amg_d_base_smoother_mod
-  use amg_d_poly_coeff_mod
-  
-  type, extends(amg_d_base_smoother_type) :: amg_d_poly_smoother_type
-    ! The local solver component is inherited from the
-    ! parent type.
-    !    class(amg_d_base_solver_type), allocatable :: sv
-    !
-    integer(psb_ipk_)              :: pdegree, variant
-    integer(psb_ipk_)              :: rho_estimate=amg_poly_rho_est_power_
-    integer(psb_ipk_)              :: rho_estimate_iterations=10
-    type(psb_dspmat_type), pointer :: pa => null()
-    real(psb_dpk_), allocatable    :: poly_beta(:)
-    real(psb_dpk_)                 :: cf_a = dzero
-    real(psb_dpk_)                 :: rho_ba = -done
-  contains
-    procedure, pass(sm) :: apply_v => amg_d_poly_smoother_apply_vect
-!!$    procedure, pass(sm) :: apply_a => amg_d_poly_smoother_apply
-    procedure, pass(sm) :: dump    => amg_d_poly_smoother_dmp
-    procedure, pass(sm) :: build   => amg_d_poly_smoother_bld
-    procedure, pass(sm) :: cnv     => amg_d_poly_smoother_cnv
-    procedure, pass(sm) :: clone   => amg_d_poly_smoother_clone
-    procedure, pass(sm) :: clone_settings => amg_d_poly_smoother_clone_settings
-    procedure, pass(sm) :: clear_data     => amg_d_poly_smoother_clear_data  
-    procedure, pass(sm) :: free    => d_poly_smoother_free
-    procedure, pass(sm) :: cseti   => amg_d_poly_smoother_cseti
-    procedure, pass(sm) :: csetc   => amg_d_poly_smoother_csetc
-    procedure, pass(sm) :: csetr   => amg_d_poly_smoother_csetr
-    procedure, pass(sm) :: descr   => amg_d_poly_smoother_descr
-    procedure, pass(sm) :: sizeof  => d_poly_smoother_sizeof
-    procedure, pass(sm) :: default => d_poly_smoother_default
-    procedure, pass(sm) :: get_nzeros => d_poly_smoother_get_nzeros
-    procedure, pass(sm) :: get_wrksz => d_poly_smoother_get_wrksize
-    procedure, nopass   :: get_fmt    => d_poly_smoother_get_fmt
-    procedure, nopass   :: get_id     => d_poly_smoother_get_id
-  end type amg_d_poly_smoother_type
-  private :: d_poly_smoother_free, &
-       & d_poly_smoother_sizeof,  d_poly_smoother_get_nzeros, &
-       & d_poly_smoother_get_fmt, d_poly_smoother_get_id, &
-       & d_poly_smoother_get_wrksize
-
-
-  interface
-    subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
-         & sweeps,work,wv,info,init,initu)
-      import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
-           & psb_ipk_
-
-      type(psb_desc_type), intent(in)                 :: desc_data
-      class(amg_d_poly_smoother_type), intent(inout) :: sm
-      type(psb_d_vect_type),intent(inout)           :: x
-      type(psb_d_vect_type),intent(inout)           :: y
-      real(psb_dpk_),intent(in)                      :: alpha,beta
-      character(len=1),intent(in)                     :: trans
-      integer(psb_ipk_), intent(in)                   :: sweeps
-      real(psb_dpk_),target, intent(inout)           :: work(:)
-      type(psb_d_vect_type),intent(inout)           :: wv(:)
-      integer(psb_ipk_), intent(out)                  :: info
-      character, intent(in), optional                :: init
-      type(psb_d_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_d_poly_smoother_apply_vect
-  end interface
-
-!!$  interface
-!!$    subroutine amg_d_poly_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
-!!$         & sweeps,work,info,init,initu)
-!!$      import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
-!!$           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
-!!$           & psb_ipk_
-!!$      type(psb_desc_type), intent(in)      :: desc_data
-!!$      class(amg_d_poly_smoother_type), intent(inout) :: sm
-!!$      real(psb_dpk_),intent(inout)         :: x(:)
-!!$      real(psb_dpk_),intent(inout)         :: y(:)
-!!$      real(psb_dpk_),intent(in)            :: alpha,beta
-!!$      character(len=1),intent(in)           :: trans
-!!$      integer(psb_ipk_), intent(in)         :: sweeps
-!!$      real(psb_dpk_),target, intent(inout) :: work(:)
-!!$      integer(psb_ipk_), intent(out)        :: info
-!!$      character, intent(in), optional       :: init
-!!$      real(psb_dpk_),intent(inout), optional :: initu(:)
-!!$    end subroutine amg_d_poly_smoother_apply
-!!$  end interface
-!!$
-  
-  interface
-    subroutine amg_d_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
-      import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      type(psb_dspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a
-      class(amg_d_poly_smoother_type), intent(inout)       :: sm
-      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 amg_d_poly_smoother_bld
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_cnv(sm,info,amold,vmold,imold)
-      import :: amg_d_poly_smoother_type, psb_dpk_, &
-           & psb_d_base_sparse_mat, psb_d_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      class(amg_d_poly_smoother_type), intent(inout)       :: sm
-      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 amg_d_poly_smoother_cnv
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, &
-           & psb_ipk_
-      implicit none
-      class(amg_d_poly_smoother_type), intent(in) :: sm
-      type(psb_desc_type), intent(in)               :: desc
-      integer(psb_ipk_), intent(in)               :: level
-      integer(psb_ipk_), intent(out)              :: info
-      character(len=*), intent(in), optional :: prefix, head
-      logical, optional, intent(in)    :: smoother, solver, global_num
-    end subroutine amg_d_poly_smoother_dmp
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_clone(sm,smout,info)
-      import :: amg_d_poly_smoother_type, psb_dpk_, &
-           & amg_d_base_smoother_type, psb_ipk_
-      class(amg_d_poly_smoother_type), intent(inout)               :: sm
-      class(amg_d_base_smoother_type), allocatable, intent(inout) :: smout
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_d_poly_smoother_clone
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_clone_settings(sm,smout,info)
-      import :: amg_d_poly_smoother_type, psb_dpk_, &
-           & amg_d_base_smoother_type, psb_ipk_
-      class(amg_d_poly_smoother_type), intent(inout)               :: sm
-      class(amg_d_base_smoother_type), allocatable, intent(inout) :: smout
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_d_poly_smoother_clone_settings
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_clear_data(sm,info)
-      import :: amg_d_poly_smoother_type, psb_dpk_, &
-           & amg_d_base_smoother_type, psb_ipk_
-      class(amg_d_poly_smoother_type), intent(inout)               :: sm
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_d_poly_smoother_clear_data
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_descr(sm,info,iout,coarse,prefix)
-      import :: amg_d_poly_smoother_type, psb_ipk_
-      class(amg_d_poly_smoother_type), intent(in) :: sm
-      integer(psb_ipk_), intent(out)               :: info
-      integer(psb_ipk_), intent(in), optional      :: iout
-      logical, intent(in), optional                :: coarse
-      character(len=*), intent(in), optional       :: prefix
-    end subroutine amg_d_poly_smoother_descr
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_cseti(sm,what,val,info,idx)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_d_poly_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      integer(psb_ipk_), intent(in)                  :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_d_poly_smoother_cseti
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_csetc(sm,what,val,info,idx)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_d_poly_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      character(len=*), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_d_poly_smoother_csetc
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_csetr(sm,what,val,info,idx)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_d_poly_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      real(psb_dpk_), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_d_poly_smoother_csetr
-  end interface
-
-
-contains
-
-
-  subroutine d_poly_smoother_free(sm,info)
-
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_poly_smoother_type), intent(inout) :: sm
-    integer(psb_ipk_), intent(out)                  :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20)  :: name='d_poly_smoother_free'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-
-
-    if (allocated(sm%sv)) then
-      call sm%sv%free(info)
-      if (info == psb_success_) deallocate(sm%sv,stat=info)
-      if (info /= psb_success_) then
-        info = psb_err_alloc_dealloc_
-        call psb_errpush(info,name)
-        goto 9999
-      end if
-    end if
-    if (allocated(sm%poly_beta))  deallocate(sm%poly_beta)
-    sm%pa => null()
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_poly_smoother_free
-
-  function d_poly_smoother_sizeof(sm) result(val)
-
-    implicit none
-    ! Arguments
-    class(amg_d_poly_smoother_type), intent(in) :: sm
-    integer(psb_epk_) :: val
-
-    val = psb_sizeof_dp
-    if (allocated(sm%sv)) val = val + sm%sv%sizeof()
-    if (allocated(sm%poly_beta)) val = val + psb_sizeof_dp * size(sm%poly_beta)
-
-    return
-  end function d_poly_smoother_sizeof
-
-  subroutine d_poly_smoother_default(sm)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_poly_smoother_type), intent(inout) :: sm
-
-    !
-    ! Default: BJAC with no residual check
-    !
-    sm%pdegree      = 1
-    sm%rho_ba       = -done
-    sm%variant      = amg_poly_lottes_
-    sm%rho_estimate = amg_poly_rho_est_power_
-    sm%rho_estimate_iterations = 20
-    if (allocated(sm%sv)) then
-      call sm%sv%default()
-    end if
-
-    return
-  end subroutine d_poly_smoother_default
-
-  function d_poly_smoother_get_nzeros(sm) result(val)
-
-    implicit none
-    ! Arguments
-    class(amg_d_poly_smoother_type), intent(in) :: sm
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-
-    val = 0
-    if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()
-
-    return
-  end function d_poly_smoother_get_nzeros
-
-  function d_poly_smoother_get_wrksize(sm) result(val)
-    implicit none
-    class(amg_d_poly_smoother_type), intent(inout) :: sm
-    integer(psb_ipk_)  :: val
-
-    val = 4
-    if (allocated(sm%sv)) val = val + sm%sv%get_wrksz()
-
-  end function d_poly_smoother_get_wrksize
-
-  function d_poly_smoother_get_fmt() result(val)
-    implicit none
-    character(len=32)  :: val
-
-    val = "Polynomial smoother"
-  end function d_poly_smoother_get_fmt
-
-  function d_poly_smoother_get_id() result(val)
-    implicit none
-    integer(psb_ipk_)  :: val
-
-    val = amg_poly_
-  end function d_poly_smoother_get_id
-
-
-end module amg_d_poly_smoother

amgprec/amg_d_prec_mod.f90

@@ -2,9 +2,9 @@
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !
-!    (C) Copyright 2021
+!    (C) Copyright 2020
 !
 !        Salvatore Filippone
 !        Pasqua D'Ambra
@@ -40,7 +40,7 @@
 ! Module: amg_d_prec_mod
 !
 !  This module defines the user interfaces to the real/complex, single/double
-!  precision versions of the user-level AMG4PSBLAS routines.
+!  precision versions of the user-level MLD2P4 routines.
 !
 module amg_d_prec_mod
 
@@ -55,7 +55,12 @@ module amg_d_prec_mod
   use amg_d_ainv_solver
   use amg_d_invk_solver
   use amg_d_invt_solver
-  use amg_d_krm_solver
+
+  interface amg_precset
+    module procedure amg_d_iprecsetsm, amg_d_iprecsetsv, &
+         & amg_d_cprecseti, amg_d_cprecsetc, amg_d_cprecsetr, &
+         & amg_d_iprecsetag
+  end interface amg_precset
 
   interface amg_extprol_bld
     subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
@@ -77,4 +82,61 @@ module amg_d_prec_mod
     end subroutine amg_d_extprol_bld
   end interface amg_extprol_bld
 
+contains
+
+  subroutine amg_d_iprecsetsm(p,val,info,pos)
+    type(amg_dprec_type), intent(inout)    :: p
+    class(amg_d_base_smoother_type), intent(in)   :: val
+    integer(psb_ipk_), intent(out)           :: info
+    character(len=*), optional, intent(in)      :: pos
+
+    call p%set(val,info,pos=pos)
+  end subroutine amg_d_iprecsetsm
+
+  subroutine amg_d_iprecsetsv(p,val,info,pos)
+    type(amg_dprec_type), intent(inout)    :: p
+    class(amg_d_base_solver_type), intent(in)   :: val
+    integer(psb_ipk_), intent(out)                :: info
+    character(len=*), optional, intent(in)      :: pos
+    call p%set(val,info, pos=pos)
+  end subroutine amg_d_iprecsetsv
+
+  subroutine amg_d_iprecsetag(p,val,info,pos)
+    type(amg_dprec_type), intent(inout)    :: p
+    class(amg_d_base_aggregator_type), intent(in)   :: val
+    integer(psb_ipk_), intent(out)                :: info
+    character(len=*), optional, intent(in)      :: pos
+    call p%set(val,info, pos=pos)
+  end subroutine amg_d_iprecsetag
+
+  subroutine amg_d_cprecseti(p,what,val,info,pos)
+    type(amg_dprec_type), intent(inout)   :: p
+    character(len=*), intent(in)            :: what
+    integer(psb_ipk_), intent(in)           :: val
+    integer(psb_ipk_), intent(out)          :: info
+    character(len=*), optional, intent(in)      :: pos
+
+    call p%set(what,val,info,pos=pos)
+  end subroutine amg_d_cprecseti
+
+  subroutine amg_d_cprecsetr(p,what,val,info,pos)
+    type(amg_dprec_type), intent(inout)   :: p
+    character(len=*), intent(in)            :: what
+    real(psb_dpk_), intent(in)             :: val
+    integer(psb_ipk_), intent(out)          :: info
+    character(len=*), optional, intent(in)      :: pos
+
+    call p%set(what,val,info,pos=pos)
+  end subroutine amg_d_cprecsetr
+
+  subroutine amg_d_cprecsetc(p,what,val,info,pos)
+    type(amg_dprec_type), intent(inout)   :: p
+    character(len=*), intent(in)            :: what
+    character(len=*), intent(in)            :: val
+    integer(psb_ipk_), intent(out)          :: info
+    character(len=*), optional, intent(in)      :: pos
+
+    call p%set(what,val,info,pos=pos)
+  end subroutine amg_d_cprecsetc
+
 end module amg_d_prec_mod

amgprec/amg_d_prec_type.f90

@@ -2,9 +2,9 @@
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !
-!    (C) Copyright 2021
+!    (C) Copyright 2020
 !
 !        Salvatore Filippone
 !        Pasqua D'Ambra
@@ -66,7 +66,7 @@ module amg_d_prec_type
   !
   !  This is the data type containing all the information about the multilevel
   !  preconditioner ('d', 's', 'c' and 'z', according to the real/complex,
-  !  single/double precision version of  AMG4PSBLAS).
+  !  single/double precision version of  MLD2P4).
   !  It consists of an array of 'one-level' intermediate data structures
   !  of type amg_donelev_type, each containing the information needed to apply
   !  the smoothing and the coarse-space correction at a generic level. RT is the
@@ -135,11 +135,8 @@ module amg_d_prec_type
     procedure, pass(prec)               :: build        => amg_dprecbld
     procedure, pass(prec)               :: hierarchy_build   => amg_d_hierarchy_bld
     procedure, pass(prec)               :: hierarchy_rebuild => amg_d_hierarchy_rebld
-    procedure, pass(prec)               :: hierarchy_free    => amg_d_hierarchy_free    
     procedure, pass(prec)               :: smoothers_build   => amg_d_smoothers_bld
-    procedure, pass(prec)               :: smoothers_free    => amg_d_smoothers_free
     procedure, pass(prec)               :: descr        =>  amg_dfile_prec_descr
-    procedure, pass(prec)               :: memory_use   =>  amg_dfile_prec_memory_use
   end type amg_dprec_type
 
   private :: amg_d_dump, amg_d_get_compl,  amg_d_cmp_compl,&
@@ -158,35 +155,16 @@ module amg_d_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity,prefix)
+    subroutine amg_dfile_prec_descr(prec,iout,root)
       import :: amg_dprec_type, psb_ipk_
       implicit none
       ! Arguments
-      class(amg_dprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out)          :: info
+      class(amg_dprec_type), intent(in)      :: prec
       integer(psb_ipk_), intent(in), optional :: iout
       integer(psb_ipk_), intent(in), optional :: root
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
     end subroutine amg_dfile_prec_descr
   end interface
 
-  
-  interface amg_memory_use
-    subroutine amg_dfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
-      import :: amg_dprec_type, psb_ipk_
-      implicit none
-      ! Arguments
-      class(amg_dprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: root
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_dfile_prec_memory_use
-  end interface
-
   interface amg_sizeof
     module procedure amg_dprec_sizeof
   end interface
@@ -364,14 +342,6 @@ module amg_d_prec_type
     end subroutine amg_d_smoothers_bld
   end interface amg_smoothers_bld
 
-  interface amg_smoothers_free
-    module procedure  amg_d_smoothers_free
-  end interface amg_smoothers_free
-
-  interface amg_hierarchy_free
-    module procedure amg_d_hierarchy_free
-  end interface amg_hierarchy_free
-
 contains
   !
   ! Function returning a pointer to the smoother
@@ -454,22 +424,11 @@ contains
     end if
   end function amg_d_get_nzeros
 
-  function amg_dprec_sizeof(prec, global) result(val)
+  function amg_dprec_sizeof(prec) result(val)
     implicit none
     class(amg_dprec_type), intent(in) :: prec
-    logical, intent(in), optional :: global
-    integer(psb_epk_) :: val    
+    integer(psb_epk_) :: val
     integer(psb_ipk_)        :: i
-    type(psb_ctxt_type) :: ctxt
-    
-    logical :: global_
-
-    if (present(global)) then
-      global_ = global
-    else
-      global_ = .false.
-    end if
-    
     val = 0
     val = val + psb_sizeof_ip
     if (allocated(prec%precv)) then
@@ -477,11 +436,6 @@ contains
         val = val + prec%precv(i)%sizeof()
       end do
     end if
-    if (global_) then
-      ctxt = prec%ctxt
-      call psb_sum(ctxt,val)
-    end if
-
   end function amg_dprec_sizeof
 
   !
@@ -645,68 +599,6 @@ contains
 
   end subroutine amg_d_prec_free
 
-  subroutine amg_d_smoothers_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_dprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_d_smoothers_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
-        call prec%precv(i)%free_smoothers(info)
-      end do
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_d_smoothers_free
-
-  subroutine amg_d_hierarchy_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_dprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_d_hierarchy_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    me=-1
-    write(0,*) 'Missing implementation '
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_d_hierarchy_free
 
 
   !
@@ -846,15 +738,16 @@ contains
     character(len=*), intent(in), optional  :: prefix, head
     logical, optional, intent(in)    :: smoother, solver,ac, rp, tprol, global_num
     integer(psb_ipk_)   :: i, j, il1, iln, lev
-    type(psb_ctxt_type) :: ctxt
+    type(psb_ctxt_type) :: icontxt
     integer(psb_ipk_)   :: iam, np, iproc_
     character(len=80)   :: prefix_
     character(len=120)  :: fname ! len should be at least 20 more than
     !  len of prefix_
 
     info = 0
-    ctxt = prec%ctxt
-    call psb_info(ctxt,iam,np)
+    icontxt = prec%ctxt
+    call psb_info(icontxt,iam,np)
+
     iln = size(prec%precv)
     if (present(istart)) then
       il1 = max(1,istart)
@@ -919,13 +812,13 @@ contains
     integer(psb_ipk_), intent(out)             :: info
     ! Local vars
     integer(psb_ipk_)   :: i, j, ln, lev
-    type(psb_ctxt_type) :: ctxt
+    type(psb_ctxt_type) :: icontxt
     integer(psb_ipk_)   :: iam, np
 
     info = psb_success_
     select type(pout => precout)
     class is (amg_dprec_type)
-      pout%ctxt          = prec%ctxt
+      pout%ctxt         = prec%ctxt
       pout%ag_data       = prec%ag_data
       pout%outer_sweeps  = prec%outer_sweeps
       if (allocated(prec%precv)) then
@@ -941,8 +834,8 @@ contains
           if (info == psb_success_) then
             pout%precv(lev)%base_a       => pout%precv(lev)%ac
             pout%precv(lev)%base_desc    => pout%precv(lev)%desc_ac
-            pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
-            pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
+            pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
+            pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
           end if
         end do
       end if
@@ -982,8 +875,8 @@ contains
       do i=2, size(b%precv)
         b%precv(i)%base_a    => b%precv(i)%ac
         b%precv(i)%base_desc => b%precv(i)%desc_ac
-        b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
-        b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
+        b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
+        b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
       end do
 
     else

amgprec/amg_d_rkr_solver.f90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!
+!    (C) Copyright 2020
+!
 !        Salvatore Filippone
 !        Pasqua D'Ambra
 !        Fabio Durastante
@@ -55,14 +52,14 @@
 !      2. Redistributions in binary form must reproduce the above copyright
 !         notice, this list of conditions, and the following disclaimer in the
 !         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!      3. The name of the MLD2P4 group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
 !
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
 !    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 !    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 !    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
@@ -73,16 +70,16 @@
 !
 !
 !
-! File: amg_d_krm_solver_mod.f90
+! File: amg_d_rkr_solver_mod.f90
 !
-! Module: amg_d_krm_solver_mod
+! Module: amg_d_rkr_solver_mod
 !
-module amg_d_krm_solver
+module amg_d_rkr_solver
 
   use amg_d_base_solver_mod
   use amg_d_prec_type
 
-  type, extends(amg_d_base_solver_type) :: amg_d_krm_solver_type
+  type, extends(amg_d_base_solver_type) :: amg_d_rkr_solver_type
     !
     logical               :: global
     character(len=16)     :: method, kprec, sub_solve
@@ -97,46 +94,46 @@ module amg_d_krm_solver
   contains
     !
     !
-    procedure, pass(sv) :: dump    => d_krm_solver_dmp
-    procedure, pass(sv) :: check   => d_krm_solver_check
-    procedure, pass(sv) :: clone   => d_krm_solver_clone
-    procedure, pass(sv) :: clone_settings   => d_krm_solver_clone_settings
-    procedure, pass(sv) :: cnv     => d_krm_solver_cnv
-    procedure, pass(sv) :: apply_v => amg_d_krm_solver_apply_vect
-    procedure, pass(sv) :: apply_a => amg_d_krm_solver_apply
-    procedure, pass(sv) :: clear_data  => d_krm_solver_clear_data
-    procedure, pass(sv) :: free    => d_krm_solver_free
-    procedure, pass(sv) :: cseti   => d_krm_solver_cseti
-    procedure, pass(sv) :: csetc   => d_krm_solver_csetc
-    procedure, pass(sv) :: csetr   => d_krm_solver_csetr
-    procedure, pass(sv) :: sizeof  => d_krm_solver_sizeof
-    procedure, pass(sv) :: get_nzeros => d_krm_solver_get_nzeros
-    !procedure, nopass   :: get_id  => d_krm_solver_get_id
-    procedure, pass(sv) :: is_global => d_krm_solver_is_global
-    procedure, nopass   :: is_iterative => d_krm_solver_is_iterative
+    procedure, pass(sv) :: dump    => d_rkr_solver_dmp
+    procedure, pass(sv) :: check   => d_rkr_solver_check
+    procedure, pass(sv) :: clone   => d_rkr_solver_clone
+    procedure, pass(sv) :: clone_settings   => d_rkr_solver_clone_settings
+    procedure, pass(sv) :: cnv     => d_rkr_solver_cnv
+    procedure, pass(sv) :: apply_v => amg_d_rkr_solver_apply_vect
+    procedure, pass(sv) :: apply_a => amg_d_rkr_solver_apply
+    procedure, pass(sv) :: clear_data  => d_rkr_solver_clear_data
+    procedure, pass(sv) :: free    => d_rkr_solver_free
+    procedure, pass(sv) :: cseti   => d_rkr_solver_cseti
+    procedure, pass(sv) :: csetc   => d_rkr_solver_csetc
+    procedure, pass(sv) :: csetr   => d_rkr_solver_csetr
+    procedure, pass(sv) :: sizeof  => d_rkr_solver_sizeof
+    procedure, pass(sv) :: get_nzeros => d_rkr_solver_get_nzeros
+    !procedure, nopass   :: get_id  => d_rkr_solver_get_id
+    procedure, pass(sv) :: is_global => d_rkr_solver_is_global
+    procedure, nopass   :: is_iterative => d_rkr_solver_is_iterative
 
 
     !
     ! These methods are specific for the new solver type
     ! and therefore need to be overridden
     !
-    procedure, pass(sv) :: descr   => d_krm_solver_descr
-    procedure, pass(sv) :: default => d_krm_solver_default
-    procedure, pass(sv) :: build   => amg_d_krm_solver_bld
-    procedure, nopass   :: get_fmt => d_krm_solver_get_fmt
-  end type amg_d_krm_solver_type
+    procedure, pass(sv) :: descr   => d_rkr_solver_descr
+    procedure, pass(sv) :: default => d_rkr_solver_default
+    procedure, pass(sv) :: build   => amg_d_rkr_solver_bld
+    procedure, nopass   :: get_fmt => d_rkr_solver_get_fmt
+  end type amg_d_rkr_solver_type
 
 
-  private ::  d_krm_solver_get_fmt, d_krm_solver_descr, d_krm_solver_default
+  private ::  d_rkr_solver_get_fmt, d_rkr_solver_descr, d_rkr_solver_default
 
   interface
-    subroutine amg_d_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
+    subroutine amg_d_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
          & trans,work,wv,info,init,initu)
-      import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
+      import :: psb_desc_type, amg_d_rkr_solver_type, psb_d_vect_type, psb_dpk_, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
       implicit none
       type(psb_desc_type), intent(in)             :: desc_data
-      class(amg_d_krm_solver_type), intent(inout) :: sv
+      class(amg_d_rkr_solver_type), intent(inout) :: sv
       type(psb_d_vect_type),intent(inout)         :: x
       type(psb_d_vect_type),intent(inout)         :: y
       real(psb_dpk_),intent(in)                    :: alpha,beta
@@ -146,17 +143,17 @@ module amg_d_krm_solver
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init
       type(psb_d_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_d_krm_solver_apply_vect
+    end subroutine amg_d_rkr_solver_apply_vect
   end interface
 
   interface
-    subroutine amg_d_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
+    subroutine amg_d_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
          & trans,work,info,init,initu)
-      import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
+      import :: psb_desc_type, amg_d_rkr_solver_type, psb_d_vect_type, psb_dpk_, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
       implicit none
       type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_d_krm_solver_type), intent(inout) :: sv
+      class(amg_d_rkr_solver_type), intent(inout) :: sv
       real(psb_dpk_),intent(inout)         :: x(:)
       real(psb_dpk_),intent(inout)         :: y(:)
       real(psb_dpk_),intent(in)            :: alpha,beta
@@ -165,24 +162,24 @@ module amg_d_krm_solver
       integer(psb_ipk_), intent(out)        :: info
       character, intent(in), optional       :: init
       real(psb_dpk_),intent(inout), optional :: initu(:)
-    end subroutine amg_d_krm_solver_apply
+    end subroutine amg_d_rkr_solver_apply
   end interface
 
   interface
-    subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
+    subroutine amg_d_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
+      import :: psb_desc_type, amg_d_rkr_solver_type, psb_d_vect_type, psb_dpk_, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none
       type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
-      class(amg_d_krm_solver_type), intent(inout)         :: sv
+      class(amg_d_rkr_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info
       type(psb_dspmat_type), intent(in), target, optional :: b
       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 amg_d_krm_solver_bld
+    end subroutine amg_d_rkr_solver_bld
   end interface
 
 
@@ -190,12 +187,12 @@ contains
 
   !
   !
-  subroutine d_krm_solver_default(sv)
+  subroutine d_rkr_solver_default(sv)
 
     Implicit None
 
     ! Arguments
-    class(amg_d_krm_solver_type), intent(inout) :: sv
+    class(amg_d_rkr_solver_type), intent(inout) :: sv
 
     sv%method     = 'bicgstab'
     sv%kprec      = 'bjac'
@@ -210,42 +207,42 @@ contains
     sv%global = .false.
 
     return
-  end subroutine d_krm_solver_default
+  end subroutine d_rkr_solver_default
 
-  function d_krm_solver_get_nzeros(sv) result(val)
+  function d_rkr_solver_get_nzeros(sv) result(val)
 
     implicit none
     ! Arguments
-    class(amg_d_krm_solver_type), intent(in) :: sv
+    class(amg_d_rkr_solver_type), intent(in) :: sv
     integer(psb_epk_) :: val
 
     val = sv%prec%get_nzeros()
 
     return
-  end function d_krm_solver_get_nzeros
+  end function d_rkr_solver_get_nzeros
 
-  function d_krm_solver_sizeof(sv) result(val)
+  function d_rkr_solver_sizeof(sv) result(val)
 
     implicit none
     ! Arguments
-    class(amg_d_krm_solver_type), intent(in) :: sv
+    class(amg_d_rkr_solver_type), intent(in) :: sv
     integer(psb_epk_) :: val
 
     val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
 
     return
-  end function d_krm_solver_sizeof
+  end function d_rkr_solver_sizeof
 
 
-  subroutine d_krm_solver_check(sv,info)
+  subroutine d_rkr_solver_check(sv,info)
 
     Implicit None
 
     ! Arguments
-    class(amg_d_krm_solver_type), intent(inout) :: sv
+    class(amg_d_rkr_solver_type), intent(inout) :: sv
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_) :: err_act
-    character(len=20) :: name='d_krm_solver_check'
+    character(len=20) :: name='d_rkr_solver_check'
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -259,36 +256,36 @@ contains
 9999 call psb_error_handler(err_act)
     return
 
-  end subroutine d_krm_solver_check
+  end subroutine d_rkr_solver_check
 
-  subroutine d_krm_solver_cseti(sv,what,val,info,idx)
+  subroutine d_rkr_solver_cseti(sv,what,val,info,idx)
 
     Implicit None
 
     ! Arguments
-    class(amg_d_krm_solver_type), intent(inout) :: sv
+    class(amg_d_rkr_solver_type), intent(inout) :: sv
     character(len=*), intent(in)                  :: what
     integer(psb_ipk_), intent(in)                 :: val
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_), intent(in), optional       :: idx
     integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='d_krm_solver_cseti'
+    character(len=20)  :: name='d_rkr_solver_cseti'
 
     info = psb_success_
     call psb_erractionsave(err_act)
 
     select case(psb_toupper(trim(what)))
-    case('KRM_IRST')
+    case('RKR_IRST')
       sv%irst = val
-    case('KRM_ISTOPC')
+    case('RKR_ISTOPC')
       sv%istopc = val
-    case('KRM_ITMAX')
+    case('RKR_ITMAX')
       sv%itmax = val
-    case('KRM_ITRACE')
+    case('RKR_ITRACE')
       sv%itrace = val
-    case('KRM_SUB_SOLVE')
+    case('RKR_SUB_SOLVE')
       sv%i_sub_solve = val
-    case('KRM_FILLIN')
+    case('RKR_FILLIN')
       sv%fillin = val
     case default
       call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
@@ -299,33 +296,33 @@ contains
 
 9999 call psb_error_handler(err_act)
     return
-  end subroutine d_krm_solver_cseti
+  end subroutine d_rkr_solver_cseti
 
-  subroutine d_krm_solver_csetc(sv,what,val,info,idx)
+  subroutine d_rkr_solver_csetc(sv,what,val,info,idx)
 
     Implicit None
 
     ! Arguments
-    class(amg_d_krm_solver_type), intent(inout) :: sv
+    class(amg_d_rkr_solver_type), intent(inout) :: sv
     character(len=*), intent(in)                  :: what
     character(len=*), intent(in)                  :: val
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_), intent(in), optional       :: idx
     integer(psb_ipk_)  :: err_act, ival
-    character(len=20)  :: name='d_krm_solver_csetc'
+    character(len=20)  :: name='d_rkr_solver_csetc'
 
     info = psb_success_
     call psb_erractionsave(err_act)
 
 
     select case(psb_toupper(trim(what)))
-    case('KRM_METHOD')
+    case('RKR_METHOD')
       sv%method = psb_toupper(trim(val))
-    case('KRM_KPREC')
+    case('RKR_KPREC')
       sv%kprec = psb_toupper(trim(val))
-    case('KRM_SUB_SOLVE')
+    case('RKR_SUB_SOLVE')
       sv%sub_solve = psb_toupper(trim(val))
-    case('KRM_GLOBAL')
+    case('RKR_GLOBAL')
       select case(psb_toupper(trim(val)))
       case('LOCAL','FALSE')
         sv%global = .false.
@@ -348,26 +345,26 @@ contains
 
 9999 call psb_error_handler(err_act)
     return
-  end subroutine d_krm_solver_csetc
+  end subroutine d_rkr_solver_csetc
 
-  subroutine d_krm_solver_csetr(sv,what,val,info,idx)
+  subroutine d_rkr_solver_csetr(sv,what,val,info,idx)
 
     Implicit None
 
     ! Arguments
-    class(amg_d_krm_solver_type), intent(inout) :: sv
+    class(amg_d_rkr_solver_type), intent(inout) :: sv
     character(len=*), intent(in)                  :: what
     real(psb_dpk_), intent(in)                  :: val
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_), intent(in), optional       :: idx
     integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='d_krm_solver_csetr'
+    character(len=20)  :: name='d_rkr_solver_csetr'
 
     call psb_erractionsave(err_act)
     info = psb_success_
 
     select case(psb_toupper(what))
-    case('KRM_EPS')
+    case('RKR_EPS')
       sv%eps = val
     case default
       call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
@@ -378,18 +375,18 @@ contains
 
 9999 call psb_error_handler(err_act)
     return
-  end subroutine d_krm_solver_csetr
+  end subroutine d_rkr_solver_csetr
 
-  subroutine d_krm_solver_clear_data(sv,info)
+  subroutine d_rkr_solver_clear_data(sv,info)
     use psb_base_mod, only : psb_exit
     Implicit None
 
     ! Arguments
-    class(amg_d_krm_solver_type), intent(inout) :: sv
+    class(amg_d_rkr_solver_type), intent(inout) :: sv
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_) :: err_act
     type(psb_ctxt_type)  :: l_ctxt
-    character(len=20)  :: name='d_krm_solver_free'
+    character(len=20)  :: name='d_rkr_solver_free'
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -406,19 +403,19 @@ contains
     nullify(sv%a)
     call psb_erractionrestore(err_act)
     return
-  end subroutine d_krm_solver_clear_data
+  end subroutine d_rkr_solver_clear_data
 
 
-  subroutine d_krm_solver_free(sv,info)
+  subroutine d_rkr_solver_free(sv,info)
     use psb_base_mod, only : psb_exit
     Implicit None
 
     ! Arguments
-    class(amg_d_krm_solver_type), intent(inout) :: sv
+    class(amg_d_rkr_solver_type), intent(inout) :: sv
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_)  :: err_act
     type(psb_ctxt_type) :: l_ctxt
-    character(len=20)  :: name='d_krm_solver_free'
+    character(len=20)  :: name='d_rkr_solver_free'
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -427,31 +424,29 @@ contains
 
     call psb_erractionrestore(err_act)
     return
-  end subroutine d_krm_solver_free
+  end subroutine d_rkr_solver_free
 
-  function d_krm_solver_get_fmt() result(val)
+  function d_rkr_solver_get_fmt() result(val)
     implicit none
     character(len=32)  :: val
 
-    val = "KRM solver"
-  end function d_krm_solver_get_fmt
+    val = "RKR solver"
+  end function d_rkr_solver_get_fmt
 
-  subroutine d_krm_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine d_rkr_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
-    class(amg_d_krm_solver_type), intent(in) :: sv
+    class(amg_d_rkr_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional              :: coarse
-    character(len=*), intent(in), optional  :: prefix
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_d_krm_solver_descr'
+    character(len=20), parameter :: name='amg_d_rkr_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -460,33 +455,34 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
     if (sv%global) then
-      write(iout_,*) trim(prefix_), '  Krylov solver (global)'
+      write(iout_,*) '  Recursive Krylov solver (global)'
     else
-      write(iout_,*) trim(prefix_), '  Krylov solver (local) '
+      write(iout_,*) '  Recursive Krylov solver (local) '
     end if
-    write(iout_,*) trim(prefix_), '    method: ',sv%method
-    write(iout_,*) trim(prefix_), '     kprec: ',sv%kprec
-    call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
-    write(iout_,*) trim(prefix_), '     itmax: ',sv%itmax
-    write(iout_,*) trim(prefix_), '       eps: ',sv%eps
+    write(iout_,*) '    method: ',sv%method
+    write(iout_,*) '     kprec: ',sv%kprec
+    if (sv%i_sub_solve > 0) then
+      write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
+    else
+      write(iout_,*) ' sub_solve: ',sv%sub_solve
+    end if
+    write(iout_,*) '     itmax: ',sv%itmax
+    write(iout_,*) '       eps: ',sv%eps
+    write(iout_,*) '    fillin: ',sv%fillin
+
 
     call psb_erractionrestore(err_act)
     return
 
 9999 call psb_error_handler(err_act)
     return
-  end subroutine d_krm_solver_descr
+  end subroutine d_rkr_solver_descr
 
-  subroutine d_krm_solver_cnv(sv,info,amold,vmold,imold)
+  subroutine d_rkr_solver_cnv(sv,info,amold,vmold,imold)
     implicit none
-    class(amg_d_krm_solver_type), intent(inout)         :: sv
+    class(amg_d_rkr_solver_type), intent(inout)         :: sv
     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
@@ -494,13 +490,13 @@ contains
 
     call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
 
-  end subroutine d_krm_solver_cnv
+  end subroutine d_rkr_solver_cnv
 
-  subroutine d_krm_solver_clone(sv,svout,info)
+  subroutine d_rkr_solver_clone(sv,svout,info)
     Implicit None
 
     ! Arguments
-    class(amg_d_krm_solver_type), intent(inout)               :: sv
+    class(amg_d_rkr_solver_type), intent(inout)               :: sv
     class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
     integer(psb_ipk_), intent(out)              :: info
 
@@ -509,7 +505,7 @@ contains
     call svout%free(info)
     allocate(svout,stat=info,mold=sv)
     select type(so=>svout)
-    class is(amg_d_krm_solver_type)
+    class is(amg_d_rkr_solver_type)
       so%method = sv%method
       so%kprec  = sv%kprec
       so%sub_solve = sv%sub_solve
@@ -528,21 +524,21 @@ contains
       info = psb_err_internal_error_
     end select
 
-  end subroutine d_krm_solver_clone
+  end subroutine d_rkr_solver_clone
 
 
-  subroutine d_krm_solver_clone_settings(sv,svout,info)
+  subroutine d_rkr_solver_clone_settings(sv,svout,info)
     Implicit None
 
     ! Arguments
-    class(amg_d_krm_solver_type), intent(inout)               :: sv
+    class(amg_d_rkr_solver_type), intent(inout)               :: sv
     class(amg_d_base_solver_type), intent(inout) :: svout
     integer(psb_ipk_), intent(out)              :: info
 
     info = psb_success_
 
     select type(so=>svout)
-    class is(amg_d_krm_solver_type)
+    class is(amg_d_rkr_solver_type)
       so%method = sv%method
       so%kprec  = sv%kprec
       so%sub_solve = sv%sub_solve
@@ -558,11 +554,11 @@ contains
       info = psb_err_internal_error_
     end select
 
-  end subroutine d_krm_solver_clone_settings
+  end subroutine d_rkr_solver_clone_settings
 
-  subroutine d_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
+  subroutine d_rkr_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
     implicit none
-    class(amg_d_krm_solver_type), intent(in) :: sv
+    class(amg_d_rkr_solver_type), intent(in) :: sv
     type(psb_desc_type), intent(in)             :: desc
     integer(psb_ipk_), intent(in)              :: level
     integer(psb_ipk_), intent(out)             :: info
@@ -572,23 +568,23 @@ contains
 
     call sv%prec%dump(info,prefix=prefix,head=head)
 
-  end subroutine d_krm_solver_dmp
+  end subroutine d_rkr_solver_dmp
   !
-  ! Notify whether KRM is used as a global solver
+  ! Notify whether RKR is used as a global solver
   !
-  function d_krm_solver_is_global(sv) result(val)
+  function d_rkr_solver_is_global(sv) result(val)
     implicit none
-    class(amg_d_krm_solver_type), intent(in) :: sv
+    class(amg_d_rkr_solver_type), intent(in) :: sv
     logical  :: val
 
     val = (sv%global)
-  end function d_krm_solver_is_global
+  end function d_rkr_solver_is_global
   !
-  function d_krm_solver_is_iterative() result(val)
+  function d_rkr_solver_is_iterative() result(val)
     implicit none
     logical  :: val
 
     val = .true.
-  end function d_krm_solver_is_iterative
+  end function d_rkr_solver_is_iterative
 
-end module amg_d_krm_solver
+end module amg_d_rkr_solver

amgprec/amg_d_slu_solver.F90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -385,22 +385,20 @@ contains
   
   end subroutine d_slu_solver_finalize
 
-  subroutine d_slu_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine d_slu_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_d_slu_solver_type), intent(in) :: sv
-    integer, intent(out)                       :: info
-    integer, intent(in), optional              :: iout
-    logical, intent(in), optional              :: coarse
-    character(len=*), intent(in), optional     :: prefix
+    integer, intent(out)                     :: info
+    integer, intent(in), optional            :: iout
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer      :: err_act
     character(len=20), parameter :: name='amg_d_slu_solver_descr'
     integer :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -409,13 +407,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
     
-    write(iout_,*) trim(prefix_), '  SuperLU Sparse Factorization Solver. '
+    write(iout_,*) '  SuperLU Sparse Factorization Solver. '
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_d_sludist_solver.F90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -52,7 +52,7 @@ module amg_d_sludist_solver
   use iso_c_binding
   use amg_d_base_solver_mod
 
-#if (!defined(HAVE_SLUDIST_)) || defined(IPK8) 
+#if defined(LPK8) 
 
   type, extends(amg_d_base_solver_type) :: amg_d_sludist_solver_type
 
@@ -270,12 +270,10 @@ contains
     ! Local variables
     type(psb_dspmat_type) :: atmp
     type(psb_d_csr_sparse_mat) :: acsr
+    integer :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
+    integer :: ifrst, ibcheck
     type(psb_ctxt_type) :: ctxt
-    integer(psb_lpk_), allocatable :: gia(:), gja(:)
-    integer(psb_lpk_) :: lfrst
-    integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
-    integer(psb_ipk_) :: ifrst, ibcheck
-    integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
+    integer :: np,me,i, err_act, debug_unit, debug_level
     character(len=20)  :: name='d_sludist_solver_bld', ch_err
     
     info=psb_success_
@@ -295,36 +293,19 @@ contains
     n_col  = desc_a%get_local_cols()
     nglob  = desc_a%get_global_rows()
     
-    !
-    ! Strategy here is as follows: because a call to SLUDIST
-    ! as a gobal solver is mostly done  at the coarsest level,
-    ! even if we start from a problem requiring 8 bytes, chances
-    ! are that the global size will be suitable for 4 bytes
-    ! anyway, so we hope for the best, and throw an error
-    ! if something goes wrong.
-    !
-    if (nglob > huge(1_psb_ipk_)) then
-      write(0,*) me,' ',trim(name),': Error: overflow of local indices '
-      info=psb_err_internal_error_
-      call psb_errpush(info,name)
-      goto 9999
-    end if
-    
-    call a%cscnv(atmp,info,type='csr')
-    ! This in case we are dealing with AS
+    call a%cscnv(atmp,info,type='coo')
     call psb_rwextd(n_row,atmp,info,b=b) 
+    call atmp%cscnv(info,type='csr',dupl=psb_dupl_add_)
     call atmp%mv_to(acsr)
     nrow_a = acsr%get_nrows()
     nztota = acsr%get_nzeros()
-    call psb_loc_to_glob(ione,lfrst,desc_a,info)
-    
     ! Fix the entries to call C-base SuperLU
-    call psb_realloc(nztota,gja,info)
-    call psb_loc_to_glob(acsr%ja(1:nztota),gja(1:nztota), desc_a, info, iact='I')
-    acsr%ja(1:nztota) = gja(1:nztota)
+    call psb_loc_to_glob(1,ifrst,desc_a,info) 
+    call psb_loc_to_glob(nrow_a,ibcheck,desc_a,info) 
+    call psb_loc_to_glob(acsr%ja(1:nztota),desc_a,info,iact='I')
     acsr%ja(:)  = acsr%ja(:)  - 1
     acsr%irp(:) = acsr%irp(:) - 1
-    ifrst = lfrst - 1
+    ifrst = ifrst - 1
     info = amg_dsludist_fact(nglob,nrow_a,nztota,ifrst,&
          & acsr%val,acsr%irp,acsr%ja,sv%lufactors,&
          & npr,npc)
@@ -337,6 +318,7 @@ contains
     end if
     
     call acsr%free()
+    call atmp%free()
 
     if (debug_level >= psb_debug_outer_) &
          & write(debug_unit,*) me,' ',trim(name),' end'
@@ -421,16 +403,15 @@ contains
   
   end subroutine d_sludist_solver_finalize
 
-  subroutine d_sludist_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine d_sludist_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_d_sludist_solver_type), intent(in) :: sv
-    integer, intent(out)                           :: info
-    integer, intent(in), optional                  :: iout
-    logical, intent(in), optional                  :: coarse
-    character(len=*), intent(in), optional         :: prefix
+    integer, intent(out)                     :: info
+    integer, intent(in), optional            :: iout
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer      :: err_act
@@ -438,7 +419,6 @@ contains
     integer      :: me, np
     character(len=20), parameter :: name='amg_d_sludist_solver_descr'
     integer :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -447,13 +427,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
     
-    write(iout_,*) trim(prefix_), '  SuperLU_Dist Sparse Factorization Solver. '
+    write(iout_,*) '  SuperLU_Dist Sparse Factorization Solver. '
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_d_symdec_aggregator_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -88,25 +88,16 @@ contains
     val = "Symmetric Decoupled aggregation"
   end function amg_d_symdec_aggregator_fmt
   
-  subroutine  amg_d_symdec_aggregator_descr(ag,parms,iout,info,prefix)
+  subroutine  amg_d_symdec_aggregator_descr(ag,parms,iout,info)
     implicit none 
     class(amg_d_symdec_aggregator_type), intent(in) :: ag
     type(amg_dml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
-    character(len=*), intent(in), optional  :: prefix
 
-    character(1024)    :: prefix_
-
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
-    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info,prefix=prefix)
+    write(iout,*) 'Decoupled Aggregator locally-symmetrized'
+    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info)
     
     return
   end subroutine amg_d_symdec_aggregator_descr

amgprec/amg_d_umf_solver.F90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -390,22 +390,20 @@ contains
   
   end subroutine d_umf_solver_finalize
 
-  subroutine d_umf_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine d_umf_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_d_umf_solver_type), intent(in) :: sv
-    integer, intent(out)                       :: info
-    integer, intent(in), optional              :: iout
-    logical, intent(in), optional              :: coarse
-      character(len=*), intent(in), optional   :: prefix
+    integer, intent(out)                     :: info
+    integer, intent(in), optional            :: iout
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer      :: err_act
     character(len=20), parameter :: name='amg_d_umf_solver_descr'
     integer :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -414,13 +412,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
     
-    write(iout_,*) trim(prefix_), '  UMFPACK Sparse Factorization Solver. '
+    write(iout_,*) '  UMFPACK Sparse Factorization Solver. '
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_prec_mod.f90

@@ -2,7 +2,7 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
 !    (C) Copyright 2020 
 !  
@@ -40,7 +40,7 @@
 ! Module: amg_prec_mod
 !
 !  This module defines the interfaces to the real/complex, single/double
-!  precision versions of the user-level AMG4PSBLAS routines.
+!  precision versions of the user-level MLD2P4 routines.
 !
 module amg_prec_mod
 

amgprec/amg_prec_type.f90

@@ -2,7 +2,7 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
 !    (C) Copyright 2020 
 !  

amgprec/amg_s_ainv_solver.F90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -58,13 +55,13 @@ module amg_s_ainv_solver
     procedure, pass(sv) :: check   => amg_s_ainv_solver_check
     procedure, pass(sv) :: build   => amg_s_ainv_solver_bld
     procedure, pass(sv) :: clone   => amg_s_ainv_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_s_ainv_solver_clone_settings
     procedure, pass(sv) :: cseti   => amg_s_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_s_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_s_ainv_solver_csetr
-!!$    procedure, pass(sv) :: seti    => amg_s_ainv_solver_seti
-!!$    procedure, pass(sv) :: setc    => amg_s_ainv_solver_setc
-!!$    procedure, pass(sv) :: setr    => amg_s_ainv_solver_setr
+    procedure, pass(sv) :: seti    => amg_s_ainv_solver_seti
+    procedure, pass(sv) :: setc    => amg_s_ainv_solver_setc
+    procedure, pass(sv) :: setr    => amg_s_ainv_solver_setr
+    generic, public :: set => seti, setr, setc
     procedure, pass(sv) :: descr   => amg_s_ainv_solver_descr
     procedure, pass(sv) :: default => s_ainv_solver_default
     procedure, nopass   :: stringval  => s_ainv_stringval
@@ -86,16 +83,6 @@ module amg_s_ainv_solver
     end subroutine amg_s_ainv_solver_clone
   end interface
 
-  interface
-    subroutine amg_s_ainv_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
-       & amg_s_base_solver_type, psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
-      Implicit None
-      class(amg_s_ainv_solver_type), intent(inout)              :: sv
-      class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_s_ainv_solver_clone_settings
-  end interface
 
   interface
     subroutine amg_s_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
@@ -172,44 +159,44 @@ module amg_s_ainv_solver
     end subroutine amg_s_ainv_solver_csetr
   end interface
 
-!!$  interface
-!!$    subroutine amg_s_ainv_solver_setc(sv,what,val,info)
-!!$      import :: amg_s_ainv_solver_type, psb_ipk_
-!!$      Implicit none
-!!$      ! Arguments
-!!$      class(amg_s_ainv_solver_type), intent(inout) :: sv
-!!$      integer(psb_ipk_), intent(in)                :: what
-!!$      character(len=*), intent(in)                 :: val
-!!$      integer(psb_ipk_), intent(out)               :: info
-!!$    end subroutine amg_s_ainv_solver_setc
-!!$  end interface
-!!$
-!!$  interface
-!!$    subroutine amg_s_ainv_solver_seti(sv,what,val,info)
-!!$      import :: amg_s_ainv_solver_type, psb_ipk_
-!!$      Implicit none
-!!$      ! Arguments
-!!$      class(amg_s_ainv_solver_type), intent(inout) :: sv
-!!$      integer(psb_ipk_), intent(in)                :: what
-!!$      integer(psb_ipk_), intent(in)                :: val
-!!$      integer(psb_ipk_), intent(out)               :: info
-!!$    end subroutine amg_s_ainv_solver_seti
-!!$  end interface
-!!$
-!!$  interface
-!!$    subroutine amg_s_ainv_solver_setr(sv,what,val,info)
-!!$      import :: amg_s_ainv_solver_type, psb_ipk_, psb_spk_
-!!$      Implicit none
-!!$      ! Arguments
-!!$      class(amg_s_ainv_solver_type), intent(inout) :: sv
-!!$      integer(psb_ipk_), intent(in)                :: what
-!!$      real(psb_spk_), intent(in)                   :: val
-!!$      integer(psb_ipk_), intent(out)               :: info
-!!$    end subroutine amg_s_ainv_solver_setr
-!!$  end interface
+  interface
+    subroutine amg_s_ainv_solver_setc(sv,what,val,info)
+      import :: amg_s_ainv_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_s_ainv_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      character(len=*), intent(in)                 :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_s_ainv_solver_setc
+  end interface
 
   interface
-    subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse,prefix)
+    subroutine amg_s_ainv_solver_seti(sv,what,val,info)
+      import :: amg_s_ainv_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_s_ainv_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      integer(psb_ipk_), intent(in)                :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_s_ainv_solver_seti
+  end interface
+
+  interface
+    subroutine amg_s_ainv_solver_setr(sv,what,val,info)
+      import :: amg_s_ainv_solver_type, psb_ipk_, psb_spk_
+      Implicit none
+      ! Arguments
+      class(amg_s_ainv_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      real(psb_spk_), intent(in)                   :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_s_ainv_solver_setr
+  end interface
+
+  interface
+    subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse)
       import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
 
       Implicit None
@@ -219,7 +206,7 @@ module amg_s_ainv_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-      character(len=*), intent(in), optional  :: prefix
+
     end subroutine amg_s_ainv_solver_descr
   end interface
 

amgprec/amg_s_as_smoother.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -396,23 +396,21 @@ contains
   end subroutine s_as_smoother_default
 
 
-  subroutine s_as_smoother_descr(sm,info,iout,coarse,prefix)
+  subroutine s_as_smoother_descr(sm,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_s_as_smoother_type), intent(in) :: sm
-    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional              :: coarse
-      character(len=*), intent(in), optional   :: prefix
+    integer(psb_ipk_), intent(out)                      :: info
+    integer(psb_ipk_), intent(in), optional             :: iout
+    logical, intent(in), optional             :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_s_as_smoother_descr'
     integer(psb_ipk_) :: iout_
     logical      :: coarse_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -426,21 +424,16 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
     if (.not.coarse_) then 
-      write(iout_,*) trim(prefix_), '  Additive Schwarz with  ',&
+      write(iout_,*) '  Additive Schwarz with  ',&
            &  sm%novr, ' overlap layers.'
-      write(iout_,*) trim(prefix_), '  Restrictor:  ',restrict_names(sm%restr)
-      write(iout_,*) trim(prefix_), '  Prolongator: ',prolong_names(sm%prol)
-      write(iout_,*) trim(prefix_), '  Local solver:'
+      write(iout_,*) '  Restrictor:  ',restrict_names(sm%restr)
+      write(iout_,*) '  Prolongator: ',prolong_names(sm%prol)
+      write(iout_,*) '  Local solver:'
     endif
     if (allocated(sm%sv)) then 
-      call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
+      call sm%sv%descr(info,iout_,coarse=coarse)
     end if
 
     call psb_erractionrestore(err_act)

amgprec/amg_s_base_aggregator_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -126,7 +126,7 @@ module amg_s_base_aggregator_mod
            & psb_s_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_s_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(inout)         :: desc_a
+      type(psb_desc_type), intent(in)            :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_sml_parms), intent(inout)         :: parms 
       type(psb_s_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -144,7 +144,7 @@ module amg_s_base_aggregator_mod
            & psb_s_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_s_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(inout)         :: desc_a
+      type(psb_desc_type), intent(in)            :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_sml_parms), intent(inout)         :: parms 
       type(psb_s_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -275,22 +275,15 @@ contains
     val = .false.
   end function amg_s_base_aggregator_xt_desc
 
-  subroutine  amg_s_base_aggregator_descr(ag,parms,iout,info,prefix)
+  subroutine  amg_s_base_aggregator_descr(ag,parms,iout,info)
     implicit none 
     class(amg_s_base_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
-    character(len=*), intent(in), optional  :: prefix
-    character(1024)    :: prefix_
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
-    write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info,prefix=prefix)
+    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info)
     
     return
   end subroutine amg_s_base_aggregator_descr

amgprec/amg_s_base_ainv_mod.f90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions

amgprec/amg_s_base_smoother_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -272,7 +272,7 @@ module amg_s_base_smoother_mod
   end interface
   
   interface 
-    subroutine amg_s_base_smoother_descr(sm,info,iout,coarse,prefix)
+    subroutine amg_s_base_smoother_descr(sm,info,iout,coarse)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
            & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
            & amg_s_base_smoother_type, psb_ipk_
@@ -281,7 +281,6 @@ module amg_s_base_smoother_mod
       integer(psb_ipk_), intent(out)                :: info
       integer(psb_ipk_), intent(in), optional       :: iout
       logical, intent(in), optional                 :: coarse
-      character(len=*), intent(in), optional        :: prefix
     end subroutine amg_s_base_smoother_descr
   end interface
   

amgprec/amg_s_base_solver_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -270,7 +270,7 @@ module amg_s_base_solver_mod
   end interface
   
   interface
-    subroutine amg_s_base_solver_descr(sv,info,iout,coarse,prefix)
+    subroutine amg_s_base_solver_descr(sv,info,iout,coarse)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
            & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
            & amg_s_base_solver_type, psb_ipk_
@@ -281,7 +281,7 @@ module amg_s_base_solver_mod
       integer(psb_ipk_), intent(out)              :: info
       integer(psb_ipk_), intent(in), optional     :: iout
       logical, intent(in), optional               :: coarse
-      character(len=*), intent(in), optional      :: prefix
+
     end subroutine amg_s_base_solver_descr
   end interface 
   

amgprec/amg_s_dec_aggregator_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -184,23 +184,16 @@ contains
     val = "Decoupled aggregation"
   end function amg_s_dec_aggregator_fmt
   
-  subroutine  amg_s_dec_aggregator_descr(ag,parms,iout,info,prefix)
+  subroutine  amg_s_dec_aggregator_descr(ag,parms,iout,info)
     implicit none 
     class(amg_s_dec_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
-    character(len=*), intent(in), optional  :: prefix
-    character(1024)    :: prefix_
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
-    write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
-    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info,prefix=prefix)
+    write(iout,*) 'Decoupled Aggregator'
+    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info)
     
     return
   end subroutine amg_s_dec_aggregator_descr

amgprec/amg_s_diag_solver.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -219,7 +219,7 @@ contains
 
   end subroutine s_diag_solver_free
 
-  subroutine s_diag_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine s_diag_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
@@ -228,13 +228,11 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
-    character(len=*), intent(in), optional      :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_s_diag_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -242,13 +240,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    write(iout_,*) trim(prefix_), '  Diagonal local solver '
+    
+    write(iout_,*) '  Diagonal local solver '
 
     return
 
@@ -359,7 +352,7 @@ module amg_s_l1_diag_solver
   
 contains
 
-  subroutine s_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine s_l1_diag_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
@@ -368,13 +361,11 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
-    character(len=*), intent(in), optional  :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_s_l1_diag_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -382,13 +373,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    write(iout_,*) trim(prefix_), '  L1 Diagonal solver '
+    
+    write(iout_,*) '  L1 Diagonal solver '
 
     return
 

amgprec/amg_s_gs_solver.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -433,22 +433,20 @@ contains
     return
   end subroutine s_gs_solver_free
 
-  subroutine s_gs_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine s_gs_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_s_gs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
+    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(in), optional    :: iout
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_s_gs_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -457,17 +455,12 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     
@@ -533,22 +526,20 @@ contains
     val = .true.
   end function s_gs_solver_is_iterative
     
-  subroutine s_bwgs_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine s_bwgs_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_s_bwgs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional               :: coarse
-    character(len=*), intent(in), optional      :: prefix
+    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(in), optional    :: iout
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_s_bwgs_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -557,17 +548,12 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     

amgprec/amg_s_hybrid_aggregator_mod.F90

@@ -2,7 +2,7 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
 !    (C) Copyright 2020 
 !  

amgprec/amg_s_id_solver.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -157,7 +157,7 @@ contains
     return
   end subroutine s_id_solver_free
 
-  subroutine s_id_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine s_id_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
@@ -165,14 +165,12 @@ contains
     class(amg_s_id_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)            :: info
     integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_s_id_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -180,13 +178,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
     
-    write(iout_,*) trim(prefix_), '  Identity local solver '
+    write(iout_,*) '  Identity local solver '
 
     return
 

amgprec/amg_s_ilu_fact_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   

amgprec/amg_s_ilu_solver.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -234,7 +234,7 @@ contains
     ! Arguments
     class(amg_s_ilu_solver_type), intent(inout) :: sv
 
-    sv%fact_type = amg_ilu_n_
+    sv%fact_type = psb_ilu_n_
     sv%fill_in   = 0
     sv%thresh    = szero
 
@@ -255,13 +255,13 @@ contains
     info = psb_success_
 
     call amg_check_def(sv%fact_type,&
-         & 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
+         & 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
 
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
+    case(psb_ilu_n_,psb_milu_n_)      
       call amg_check_def(sv%fill_in,&
            & 'Level',izero,is_int_non_negative)
-    case(amg_ilu_t_)                 
+    case(psb_ilu_t_)                 
       call amg_check_def(sv%thresh,&
            & 'Eps',szero,is_legal_s_fact_thrs)
     end select
@@ -406,7 +406,7 @@ contains
     return
   end subroutine s_ilu_solver_free
 
-  subroutine s_ilu_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine s_ilu_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
@@ -414,14 +414,12 @@ contains
     class(amg_s_ilu_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional              :: coarse
-    character(len=*), intent(in), optional  :: prefix
-      
+    logical, intent(in), optional       :: coarse
+
     ! Local variables
     integer(psb_ipk_) :: err_act
     character(len=20), parameter :: name='amg_s_ilu_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -430,20 +428,15 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
-    write(iout_,*) trim(prefix_), '  Incomplete factorization solver: ',&
+    write(iout_,*) '  Incomplete factorization solver: ',&
          &  amg_fact_names(sv%fact_type)
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
-      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-    case(amg_ilu_t_)         
-      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-      write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
+    case(psb_ilu_n_,psb_milu_n_)      
+      write(iout_,*) '  Fill level:',sv%fill_in
+    case(psb_ilu_t_)         
+      write(iout_,*) '  Fill level:',sv%fill_in
+      write(iout_,*) '  Fill threshold :',sv%thresh
     end select
 
     call psb_erractionrestore(err_act)
@@ -496,7 +489,7 @@ contains
     implicit none 
     integer(psb_ipk_)  :: val
     
-    val = amg_ilu_n_
+    val = psb_ilu_n_
   end function s_ilu_solver_get_id
 
   function s_ilu_solver_get_wrksize() result(val)

amgprec/amg_s_inner_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -39,7 +39,7 @@
 !
 ! Module: amg_inner_mod
 !
-!  This module defines the interfaces to inner AMG4PSBLAS routines.
+!  This module defines the interfaces to inner MLD2P4 routines.
 !  The interfaces  of the user level routines are defined in amg_prec_mod.f90.
 !
 module amg_s_inner_mod

amgprec/amg_s_invk_solver.f90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -52,9 +49,10 @@ module amg_s_invk_solver
   contains
     procedure, pass(sv) :: check   => amg_s_invk_solver_check
     procedure, pass(sv) :: clone   => amg_s_invk_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_s_invk_solver_clone_settings
     procedure, pass(sv) :: build   => amg_s_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_s_invk_solver_cseti
+    procedure, pass(sv) :: seti    => amg_s_invk_solver_seti
+    generic, public     :: set     => seti
     procedure, pass(sv) :: descr   => amg_s_invk_solver_descr
     procedure, pass(sv) :: default => s_invk_solver_default
   end type amg_s_invk_solver_type
@@ -74,17 +72,6 @@ module amg_s_invk_solver
     end subroutine amg_s_invk_solver_clone
   end interface
 
-  interface
-    subroutine amg_s_invk_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
-       & amg_s_base_solver_type, psb_spk_, amg_s_invk_solver_type, psb_ipk_
-      Implicit None
-      class(amg_s_invk_solver_type), intent(inout)              :: sv
-      class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_s_invk_solver_clone_settings
-  end interface
-
   interface
     subroutine amg_s_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
@@ -135,7 +122,7 @@ module amg_s_invk_solver
   end interface
 
   interface
-    subroutine amg_s_invk_solver_descr(sv,info,iout,coarse,prefix)
+    subroutine amg_s_invk_solver_descr(sv,info,iout,coarse)
       import :: psb_spk_, amg_s_invk_solver_type, psb_ipk_
 
       Implicit None
@@ -145,10 +132,22 @@ module amg_s_invk_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-      character(len=*), intent(in), optional  :: prefix
+
     end subroutine amg_s_invk_solver_descr
   end interface
 
+  interface
+    subroutine amg_s_invk_solver_seti(sv,what,val,info)
+      import :: amg_s_invk_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_s_invk_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      integer(psb_ipk_), intent(in)                :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_s_invk_solver_seti
+  end interface
+
 contains
 
   subroutine s_invk_solver_default(sv)

amgprec/amg_s_invt_solver.f90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -52,10 +49,12 @@ module amg_s_invt_solver
   contains
     procedure, pass(sv) :: check   => amg_s_invt_solver_check
     procedure, pass(sv) :: clone   => amg_s_invt_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_s_invt_solver_clone_settings
     procedure, pass(sv) :: build   => amg_s_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_s_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_s_invt_solver_csetr
+    procedure, pass(sv) :: seti    => amg_s_invt_solver_seti
+    procedure, pass(sv) :: setr    => amg_s_invt_solver_setr
+    generic, public     :: set     => seti, setr
     procedure, pass(sv) :: descr   => amg_s_invt_solver_descr
     procedure, pass(sv) :: default => s_invt_solver_default
   end type amg_s_invt_solver_type
@@ -74,17 +73,6 @@ module amg_s_invt_solver
     end subroutine amg_s_invt_solver_clone
   end interface
 
-  interface
-    subroutine amg_s_invt_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
-       & amg_s_base_solver_type, psb_spk_, amg_s_invt_solver_type, psb_ipk_
-      Implicit None
-      class(amg_s_invt_solver_type), intent(inout)              :: sv
-      class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_s_invt_solver_clone_settings
-  end interface
-
   interface
     subroutine amg_s_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
@@ -146,21 +134,44 @@ module amg_s_invt_solver
   end interface
 
   interface
-    subroutine amg_s_invt_solver_descr(sv,info,iout,coarse,prefix)
+    subroutine amg_s_invt_solver_descr(sv,info,iout,coarse)
       import :: psb_spk_, amg_s_invt_solver_type, psb_ipk_
 
       Implicit None
 
       ! Arguments
       class(amg_s_invt_solver_type), intent(in) :: sv
-      integer(psb_ipk_), intent(out)              :: info
-      integer(psb_ipk_), intent(in), optional     :: iout
-      logical, intent(in), optional               :: coarse
-      character(len=*), intent(in), optional      :: prefix
+      integer(psb_ipk_), intent(out)            :: info
+      integer(psb_ipk_), intent(in), optional   :: iout
+      logical, intent(in), optional             :: coarse
 
     end subroutine amg_s_invt_solver_descr
   end interface
 
+  interface
+    subroutine amg_s_invt_solver_setr(sv,what,val,info)
+      import :: amg_s_invt_solver_type, psb_spk_, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_s_invt_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      real(psb_spk_), intent(in)                   :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_s_invt_solver_setr
+  end interface
+
+  interface
+    subroutine amg_s_invt_solver_seti(sv,what,val,info)
+      import :: amg_s_invt_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_s_invt_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      integer(psb_ipk_), intent(in)                :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine
+  end interface
+
 contains
 
   subroutine s_invt_solver_default(sv)

amgprec/amg_s_jac_smoother.f90

@@ -2,9 +2,9 @@
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !
-!    (C) Copyright 2021
+!    (C) Copyright 2020
 !
 !        Salvatore Filippone
 !        Pasqua D'Ambra
@@ -219,13 +219,12 @@ module amg_s_jac_smoother
   end interface
 
   interface
-    subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse,prefix)
+    subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse)
       import :: amg_s_jac_smoother_type, psb_ipk_
       class(amg_s_jac_smoother_type), intent(in) :: sm
       integer(psb_ipk_), intent(out)               :: info
       integer(psb_ipk_), intent(in), optional      :: iout
-      logical, intent(in), optional                :: coarse
-      character(len=*), intent(in), optional       :: prefix
+      logical, intent(in), optional              :: coarse
     end subroutine amg_s_jac_smoother_descr
   end interface
 
@@ -314,13 +313,12 @@ module amg_s_jac_smoother
   end interface
 
   interface
-    subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
+    subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse)
       import :: amg_s_l1_jac_smoother_type, psb_ipk_
       class(amg_s_l1_jac_smoother_type), intent(in) :: sm
-      integer(psb_ipk_), intent(out)                  :: info
-      integer(psb_ipk_), intent(in), optional         :: iout
-      logical, intent(in), optional                   :: coarse
-      character(len=*), intent(in), optional          :: prefix
+      integer(psb_ipk_), intent(out)               :: info
+      integer(psb_ipk_), intent(in), optional      :: iout
+      logical, intent(in), optional              :: coarse
     end subroutine amg_s_l1_jac_smoother_descr
   end interface
 

amgprec/amg_s_jac_solver.f90

@@ -1,585 +0,0 @@
-!  
-!   
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!   
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
-!
-!
-! File: amg_s_jac_solver_mod.f90
-!
-! Module: amg_s_jac_solver_mod
-!
-!  This module defines: 
-!  - the amg_s_jac_solver_type data structure containing the ingredients
-!    for a local Jacobi  iteration. The iterations are local to a process
-!    (they operate on the block diagonal).
-!    
-!
-module amg_s_jac_solver
-
-  use amg_s_base_solver_mod
-
-  type, extends(amg_s_base_solver_type) :: amg_s_jac_solver_type
-    type(psb_sspmat_type)      :: a
-    type(psb_s_vect_type), allocatable :: dv
-    real(psb_spk_), allocatable        :: d(:)
-    integer(psb_ipk_)          :: sweeps
-    real(psb_spk_)             :: eps
-  contains
-    procedure, pass(sv) :: dump    => amg_s_jac_solver_dmp
-    procedure, pass(sv) :: check   => s_jac_solver_check
-    procedure, pass(sv) :: clone   => amg_s_jac_solver_clone
-    procedure, pass(sv) :: clone_settings => amg_s_jac_solver_clone_settings
-    procedure, pass(sv) :: clear_data     => amg_s_jac_solver_clear_data
-    procedure, pass(sv) :: build   => amg_s_jac_solver_bld
-    procedure, pass(sv) :: cnv     => amg_s_jac_solver_cnv
-    procedure, pass(sv) :: apply_v => amg_s_jac_solver_apply_vect
-    procedure, pass(sv) :: apply_a => amg_s_jac_solver_apply
-    procedure, pass(sv) :: free    => s_jac_solver_free
-    procedure, pass(sv) :: cseti   => s_jac_solver_cseti
-    procedure, pass(sv) :: csetc   => s_jac_solver_csetc
-    procedure, pass(sv) :: csetr   => s_jac_solver_csetr
-    procedure, pass(sv) :: descr   => s_jac_solver_descr
-    procedure, pass(sv) :: default => s_jac_solver_default
-    procedure, pass(sv) :: sizeof  => s_jac_solver_sizeof
-    procedure, pass(sv) :: get_nzeros => s_jac_solver_get_nzeros
-    procedure, nopass   :: get_wrksz  => s_jac_solver_get_wrksize
-    procedure, nopass   :: get_fmt    => s_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => s_jac_solver_get_id
-    procedure, nopass   :: is_iterative => s_jac_solver_is_iterative
-  end type amg_s_jac_solver_type
-
-  type, extends(amg_s_jac_solver_type) :: amg_s_l1_jac_solver_type
-  contains
-    procedure, pass(sv) :: build   => amg_s_l1_jac_solver_bld
-    procedure, pass(sv) :: descr   => s_l1_jac_solver_descr
-    procedure, nopass   :: get_fmt    => s_l1_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => s_l1_jac_solver_get_id
-  end type amg_s_l1_jac_solver_type
-
-
-  private :: s_jac_solver_bld, s_jac_solver_apply, &
-       &  s_jac_solver_free,   &
-       &  s_jac_solver_descr,  s_jac_solver_sizeof, &
-       &  s_jac_solver_default, s_jac_solver_dmp, &
-       &  s_jac_solver_apply_vect, s_jac_solver_get_nzeros, &
-       &  s_jac_solver_get_fmt, s_jac_solver_check,&
-       &  s_jac_solver_is_iterative, &
-       &  s_jac_solver_get_id, s_jac_solver_get_wrksize
-
-  interface 
-    subroutine amg_s_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,work,wv,info,init,initu)
-      import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
-           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)             :: desc_data
-      class(amg_s_jac_solver_type), intent(inout) :: sv
-      type(psb_s_vect_type),intent(inout)         :: x
-      type(psb_s_vect_type),intent(inout)         :: y
-      real(psb_spk_),intent(in)                    :: alpha,beta
-      character(len=1),intent(in)                   :: trans
-      real(psb_spk_),target, intent(inout)         :: work(:)
-      type(psb_s_vect_type),intent(inout)         :: wv(:)
-      integer(psb_ipk_), intent(out)                :: info
-      character, intent(in), optional                :: init
-      type(psb_s_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_s_jac_solver_apply_vect
-  end interface
-
-  interface 
-    subroutine amg_s_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
-      import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
-           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_s_jac_solver_type), intent(inout) :: sv
-      real(psb_spk_),intent(inout)         :: x(:)
-      real(psb_spk_),intent(inout)         :: y(:)
-      real(psb_spk_),intent(in)            :: alpha,beta
-      character(len=1),intent(in)           :: trans
-      real(psb_spk_),target, intent(inout) :: work(:)
-      integer(psb_ipk_), intent(out)        :: info
-      character, intent(in), optional       :: init
-      real(psb_spk_),intent(inout), optional :: initu(:)
-    end subroutine amg_s_jac_solver_apply
-  end interface
-
-  interface 
-    subroutine amg_s_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
-           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_sspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_s_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_sspmat_type), intent(in), target, optional :: b
-      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
-    end subroutine amg_s_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_s_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_s_l1_jac_solver_type, psb_s_vect_type, psb_spk_, &
-           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_sspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_s_l1_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_sspmat_type), intent(in), target, optional :: b
-      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
-    end subroutine amg_s_l1_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_s_jac_solver_cnv(sv,info,amold,vmold,imold)
-      import :: amg_s_jac_solver_type, psb_spk_, &
-           & psb_s_base_sparse_mat, psb_s_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      class(amg_s_jac_solver_type), intent(inout)         :: sv
-      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
-    end subroutine amg_s_jac_solver_cnv
-  end interface
-  
-  interface 
-    subroutine amg_s_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
-      import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
-           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
-           & psb_ipk_
-      implicit none 
-      class(amg_s_jac_solver_type), intent(in) :: sv
-      type(psb_desc_type), intent(in)             :: desc
-      integer(psb_ipk_), intent(in)              :: level
-      integer(psb_ipk_), intent(out)             :: info
-      character(len=*), intent(in), optional     :: prefix, head
-      logical, optional, intent(in)              :: solver, global_num
-    end subroutine amg_s_jac_solver_dmp
-  end interface
-  
-  interface
-    subroutine amg_s_jac_solver_clone(sv,svout,info)
-      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
-           & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
-           & amg_s_base_solver_type, amg_s_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_s_jac_solver_type), intent(inout)               :: sv
-      class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)              :: info
-    end subroutine amg_s_jac_solver_clone
-  end interface
-  
-!!$  interface
-!!$    subroutine amg_s_l1_jac_solver_clone(sv,svout,info)
-!!$      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
-!!$           & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
-!!$           & amg_s_base_solver_type, amg_s_l1_jac_solver_type, psb_ipk_
-!!$      Implicit None
-!!$      
-!!$      ! Arguments
-!!$      class(amg_s_l1_jac_solver_type), intent(inout)               :: sv
-!!$      class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
-!!$      integer(psb_ipk_), intent(out)              :: info
-!!$    end subroutine amg_s_l1_jac_solver_clone
-!!$  end interface
-
-  interface
-    subroutine amg_s_jac_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
-           & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
-           & amg_s_base_solver_type, amg_s_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_s_jac_solver_type), intent(inout) :: sv
-      class(amg_s_base_solver_type), intent(inout) :: svout
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_s_jac_solver_clone_settings
-  end interface
-
-  interface
-    subroutine amg_s_jac_solver_clear_data(sv,info)
-      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
-           & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
-           & amg_s_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_s_jac_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(out)                 :: info
-    end subroutine amg_s_jac_solver_clear_data
-  end interface
-
-contains
-
-  subroutine s_jac_solver_default(sv)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(inout) :: sv
-
-    sv%sweeps = ione
-    sv%eps    = dzero
-    
-    return
-  end subroutine s_jac_solver_default
-
-  subroutine s_jac_solver_check(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20) :: name='s_jac_solver_check'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call amg_check_def(sv%sweeps,&
-         & 'Jacobi sweeps',ione,is_int_positive)
-
-    if (info /= psb_success_) goto 9999
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine s_jac_solver_check
-
-  subroutine s_jac_solver_cseti(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    integer(psb_ipk_), intent(in)                 :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='s_jac_solver_cseti'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-    select case(psb_toupper(what))
-    case('SOLVER_SWEEPS')
-      sv%sweeps = val      
-    case default
-      call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_jac_solver_cseti
-
-  subroutine s_jac_solver_csetc(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(inout) :: sv
-    character(len=*), intent(in)                  :: what 
-    character(len=*), intent(in)                  :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act, ival
-    character(len=20)  :: name='s_jac_solver_csetc'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-
-    call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
-  
-    if (info /= psb_success_) then
-      info = psb_err_from_subroutine_
-      call psb_errpush(info, name)
-      goto 9999
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_jac_solver_csetc
-  
-  subroutine s_jac_solver_csetr(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    real(psb_spk_), intent(in)                     :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='s_jac_solver_csetr'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    select case(psb_toupper(what))
-    case('SOLVER_EPS') 
-      sv%eps = val
-    case default
-      call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_jac_solver_csetr
-
-  subroutine s_jac_solver_free(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='s_jac_solver_free'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call sv%a%free()
-    if (allocated(sv%dv)) then
-      call sv%dv%free(info)
-      deallocate(sv%dv)
-    end if
-    if (allocated(sv%d)) deallocate(sv%d)
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_jac_solver_free
-
-  subroutine s_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_s_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_jac_solver_descr
-
-  function s_jac_solver_get_nzeros(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-    
-    val = 0 
-    val = val + sv%a%get_nzeros()
-    val = val + sv%dv%get_nrows()
-
-    return
-  end function s_jac_solver_get_nzeros
-
-  function s_jac_solver_sizeof(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-
-    val = psb_sizeof_ip 
-    val = val + sv%a%sizeof()
-    val = val + sv%dv%sizeof()
-
-    return
-  end function s_jac_solver_sizeof
-
-  function s_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "Jacobi solver"
-  end function s_jac_solver_get_fmt
-
-  function s_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_jac_
-  end function s_jac_solver_get_id
-
-  !
-  ! If this is true, then the solver needs a starting
-  ! guess. Currently only handled in JAC smoother. 
-  ! 
-  function s_jac_solver_is_iterative() result(val)
-    implicit none 
-    logical  :: val
-
-    val = .true.
-  end function s_jac_solver_is_iterative
-    
-  function s_jac_solver_get_wrksize() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = 2
-  end function s_jac_solver_get_wrksize
-
-  subroutine s_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_l1_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_s_l1_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_l1_jac_solver_descr
-
-  function s_l1_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "L1-Jacobi solver"
-  end function s_l1_jac_solver_get_fmt
-
-  function s_l1_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_l1_jac_
-  end function s_l1_jac_solver_get_id
-  
-end module amg_s_jac_solver

amgprec/amg_s_mumps_solver.F90

@@ -3,9 +3,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -78,8 +78,7 @@ module amg_s_mumps_solver
     !
     ! Controls to be set before MUMPS instantiation:
     !
-    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: 'LOCAL_SOLVER
-    !                            1==amg_global_solver_: 'GLOBAL_SOLVER'
+    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: LOCAL   1==amg_global_solver_: GLOBAL
     ! IPAR(2) : MUMPS_PRINT_ERR  print verbosity (see MUMPS)
     ! IPAR(3) : MUMPS_SYM        0: non-symmetric   2: symmetric
     integer(psb_ipk_), dimension(3) :: ipar
@@ -314,24 +313,22 @@ subroutine s_mumps_solver_finalize(sv)
 
 end subroutine s_mumps_solver_finalize
 
-subroutine s_mumps_solver_descr(sv,info,iout,coarse,prefix)
+subroutine s_mumps_solver_descr(sv,info,iout,coarse)
 
   Implicit None
 
   ! Arguments
   class(amg_s_mumps_solver_type), intent(in) :: sv
-  integer(psb_ipk_), intent(out)               :: info
-  integer(psb_ipk_), intent(in), optional      :: iout
-  logical, intent(in), optional                :: coarse
-  character(len=*), intent(in), optional       :: prefix
-      
+  integer(psb_ipk_), intent(out)                     :: info
+  integer(psb_ipk_), intent(in), optional            :: iout
+  logical, intent(in), optional       :: coarse
+
   ! Local variables
   integer(psb_ipk_)   :: err_act
   type(psb_ctxt_type) :: ctxt
   integer(psb_ipk_)   :: me, np
   character(len=20), parameter :: name='amg_z_mumps_solver_descr'
   integer(psb_ipk_) :: iout_
-  character(1024)    :: prefix_
 
   call psb_erractionsave(err_act)
   info = psb_success_
@@ -340,13 +337,8 @@ subroutine s_mumps_solver_descr(sv,info,iout,coarse,prefix)
   else
     iout_ = psb_out_unit
   endif
-  if (present(prefix)) then
-    prefix_ = prefix
-  else
-    prefix_ = ""
-  end if
 
-  write(iout_,*) trim(prefix_), '  MUMPS  Solver. '
+  write(iout_,*) '  MUMPS  Solver. '
 
   call psb_erractionrestore(err_act)
   return

amgprec/amg_s_onelev_mod.f90

@@ -1,15 +1,15 @@
-!
-!
+!  
+!   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2020 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
 !    are met:
@@ -21,7 +21,7 @@
 !      3. The name of the AMG4PSBLAS group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
-!
+!   
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -33,22 +33,22 @@
 !    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
-!
-!
+!   
+!  
 ! File: amg_s_onelev_mod.f90
 !
 ! Module: amg_s_onelev_mod
 !
-!  This module defines:
+!  This module defines: 
 !  - the amg_s_onelev_type data structure containing one level
 !    of a multilevel  preconditioner and related
 !    data structures;
 !
 !  It contains routines for
-!  - Building and applying;
+!  - Building and applying; 
 !  - checking if the preconditioner is correctly defined;
 !  - printing a	description of the preconditioner;
-!  - deallocating the preconditioner data structure.
+!  - deallocating the preconditioner data structure.  
 !
 
 module amg_s_onelev_mod
@@ -56,8 +56,6 @@ module amg_s_onelev_mod
   use amg_base_prec_type
   use amg_s_base_smoother_mod
   use amg_s_dec_aggregator_mod
-  use amg_s_parmatch_aggregator_mod
-
   use psb_base_mod, only : psb_sspmat_type, psb_s_vect_type, &
        & psb_s_base_vect_type, psb_lsspmat_type,  psb_slinmap_type, psb_spk_, &
        & psb_ipk_, psb_epk_, psb_lpk_, psb_desc_type, psb_i_base_vect_type, &
@@ -75,16 +73,16 @@ module amg_s_onelev_mod
   !    class(amg_s_base_smoother_type), pointer       :: sm2 => null()
   !    class(amg_smlprec_wrk_type), allocatable       :: wrk
   !    class(amg_s_base_aggregator_type), allocatable :: aggr
-  !    type(amg_sml_parms)             :: parms
+  !    type(amg_sml_parms)             :: parms 
   !    type(psb_sspmat_type)           :: ac
   !    type(psb_sesc_type)             :: desc_ac
-  !    type(psb_sspmat_type), pointer  :: base_a    => null()
-  !    type(psb_desc_type), pointer    :: base_desc => null()
+  !    type(psb_sspmat_type), pointer  :: base_a    => null() 
+  !    type(psb_desc_type), pointer    :: base_desc => null() 
   !    type(psb_slinmap_type)          :: map
   !  end type amg_sonelev_type
   !
   !  Note that s denotes the kind of the real data type to be chosen
-  !  according to single/double precision version of AMG4PSBLAS.
+  !  according to single/double precision version of MLD2P4.
   !
   !   sm,sm2a      -  class(amg_s_base_smoother_type), allocatable
   !                   The current level pre- and post-smooother.
@@ -95,7 +93,7 @@ module amg_s_onelev_mod
   !                   Workspace for application of preconditioner; may be
   !                   pre-allocated to save time in the application within a
   !                   Krylov solver.
-  !   aggr         -  class(amg_s_base_aggregator_type), allocatable
+  !   aggr         -  class(amg_s_base_aggregator_type), allocatable 
   !                   The aggregator object: holds the algorithmic choices and
   !                   (possibly) additional data for building the aggregation.
   !   parms        -  type(amg_sml_parms)
@@ -106,7 +104,7 @@ module amg_s_onelev_mod
   !                   The communication descriptor associated to the matrix
   !                   stored in ac.
   !   base_a       -  type(psb_sspmat_type), pointer.
-  !                   Pointer (really a pointer!) to the local part of the current
+  !                   Pointer (really a pointer!) to the local part of the current 
   !                   matrix (so we have a unified treatment of residuals).
   !                   We need this to avoid passing explicitly the current matrix
   !                   to the routine which applies the preconditioner.
@@ -117,13 +115,13 @@ module amg_s_onelev_mod
   !                   vector spaces associated to the index spaces of the previous
   !                   and current levels.
   !
-  !   Methods:
+  !   Methods:  
   !     Most methods follow the encapsulation hierarchy: they take whatever action
   !     is appropriate for the current object, then call the corresponding method for
   !     the contained object.
   !     As an example: the descr() method prints out a description of the
   !     level. It starts by invoking the descr() method of the parms object,
-  !     then calls the descr() method of the smoother object.
+  !     then calls the descr() method of the smoother object. 
   !
   !    descr      -   Prints a description of the object.
   !    default    -   Set default values
@@ -132,14 +130,14 @@ module amg_s_onelev_mod
   !                   it is passed to the smoother object for further processing.
   !    check        -  Sanity checks.
   !    sizeof       -  Total memory occupation in bytes
-  !    get_nzeros   -  Number of nonzeros
+  !    get_nzeros   -  Number of nonzeros 
   !    get_wrksz    -  How many workspace vector does apply_vect need
   !    allocate_wrk -  Allocate auxiliary workspace
   !    free_wrk     -  Free     auxiliary workspace
   !    bld_tprol    -  Invoke the aggr method to build the tentative prolongator
-  !    mat_asb      -  Build the final (possibly smoothed) prolongator and coarse matrix.
-  !
+  !    mat_asb      -  Build the final (possibly smoothed) prolongator and coarse matrix. 
   !
+  !  
   type amg_smlprec_wrk_type
     real(psb_spk_), allocatable  :: tx(:), ty(:), x2l(:), y2l(:)
     type(psb_s_vect_type)  :: vtx, vty, vx2l, vy2l
@@ -150,35 +148,25 @@ module amg_s_onelev_mod
     procedure, pass(wk) :: clone      => s_wrk_clone
     procedure, pass(wk) :: move_alloc => s_wrk_move_alloc
     procedure, pass(wk) :: cnv        => s_wrk_cnv
-    procedure, pass(wk) :: sizeof     => s_wrk_sizeof
+    procedure, pass(wk) :: sizeof     => s_wrk_sizeof    
   end type amg_smlprec_wrk_type
   private :: s_wrk_alloc, s_wrk_free, &
-       & s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv, s_wrk_sizeof
-
-  type amg_s_remap_data_type
-    type(psb_sspmat_type)          :: ac_pre_remap
-    type(psb_desc_type)            :: desc_ac_pre_remap
-    integer(psb_ipk_)              :: idest
-    integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
-  contains
-    procedure, pass(rmp) :: clone   => s_remap_data_clone
-  end type amg_s_remap_data_type
-
+       & s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv, s_wrk_sizeof    
+  
   type amg_s_onelev_type
     class(amg_s_base_smoother_type), allocatable   :: sm, sm2a
     class(amg_s_base_smoother_type), pointer       :: sm2 => null()
     class(amg_smlprec_wrk_type), allocatable       :: wrk
     class(amg_s_base_aggregator_type), allocatable :: aggr
-    type(amg_sml_parms)              :: parms
+    type(amg_sml_parms)              :: parms 
     type(psb_sspmat_type)            :: ac
     integer(psb_ipk_)                :: ac_nz_loc
     integer(psb_lpk_)                :: ac_nz_tot
     type(psb_desc_type)              :: desc_ac
-    type(psb_sspmat_type), pointer   :: base_a    => null()
-    type(psb_desc_type), pointer     :: base_desc => null()
+    type(psb_sspmat_type), pointer   :: base_a    => null() 
+    type(psb_desc_type), pointer     :: base_desc => null() 
     type(psb_lsspmat_type)           :: tprol
-    type(psb_slinmap_type)           :: linmap
-    type(amg_s_remap_data_type)      :: remap_data
+    type(psb_slinmap_type)           :: map
     real(psb_spk_)                     :: szratio
   contains
     procedure, pass(lv) :: bld_tprol   => s_base_onelev_bld_tprol
@@ -188,10 +176,8 @@ module amg_s_onelev_mod
     procedure, pass(lv) :: clone   => s_base_onelev_clone
     procedure, pass(lv) :: cnv     => amg_s_base_onelev_cnv
     procedure, pass(lv) :: descr   => amg_s_base_onelev_descr
-    procedure, pass(lv) :: memory_use  => amg_s_base_onelev_memory_use
     procedure, pass(lv) :: default => s_base_onelev_default
     procedure, pass(lv) :: free    => amg_s_base_onelev_free
-    procedure, pass(lv) :: free_smoothers => amg_s_base_onelev_free_smoothers
     procedure, pass(lv) :: nullify => s_base_onelev_nullify
     procedure, pass(lv) :: check => amg_s_base_onelev_check
     procedure, pass(lv) :: dump  => amg_s_base_onelev_dump
@@ -201,7 +187,7 @@ module amg_s_onelev_mod
     procedure, pass(lv) :: setsm => amg_s_base_onelev_setsm
     procedure, pass(lv) :: setsv => amg_s_base_onelev_setsv
     procedure, pass(lv) :: setag => amg_s_base_onelev_setag
-    generic, public     :: set   => cseti, csetr, csetc, setsm, setsv, setag
+    generic, public     :: set   => cseti, csetr, csetc, setsm, setsv, setag 
     procedure, pass(lv) :: sizeof => s_base_onelev_sizeof
     procedure, pass(lv) :: get_nzeros => s_base_onelev_get_nzeros
     procedure, pass(lv) :: get_wrksz => s_base_onelev_get_wrksize
@@ -209,14 +195,7 @@ module amg_s_onelev_mod
     procedure, pass(lv) :: free_wrk       => s_base_onelev_free_wrk
     procedure, nopass   :: stringval => amg_stringval
     procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc
-
-
-    procedure, pass(lv) :: map_rstr_a => amg_s_base_onelev_map_rstr_a
-    procedure, pass(lv) :: map_prol_a => amg_s_base_onelev_map_prol_a
-    procedure, pass(lv) :: map_rstr_v => amg_s_base_onelev_map_rstr_v
-    procedure, pass(lv) :: map_prol_v => amg_s_base_onelev_map_prol_v
-    generic, public     :: map_rstr => map_rstr_a, map_rstr_v
-    generic, public     :: map_prol => map_prol_a, map_prol_v
+    
   end type amg_s_onelev_type
 
   type amg_s_onelev_node
@@ -230,11 +209,11 @@ module amg_s_onelev_mod
        & s_base_onelev_get_wrksize, s_base_onelev_allocate_wrk, &
        & s_base_onelev_free_wrk
 
-  interface
+  interface 
     subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
       import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lsspmat_type, psb_lpk_
       import :: amg_s_onelev_type
-      implicit none
+      implicit none 
       class(amg_s_onelev_type), intent(inout), target :: lv
       type(psb_sspmat_type), intent(in) :: a
       type(psb_desc_type), intent(inout)  :: desc_a
@@ -259,172 +238,141 @@ module amg_s_onelev_mod
     end subroutine amg_s_base_onelev_build
   end interface
 
-  interface
-    subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
+  interface 
+    subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
            & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
       ! Arguments
-      class(amg_s_onelev_type), intent(in)    :: lv
-      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
+      class(amg_s_onelev_type), intent(in) :: lv
+      integer(psb_ipk_), intent(in)                 :: il,nl,ilmin
+      integer(psb_ipk_), intent(out)                :: info
+      integer(psb_ipk_), intent(in), optional       :: iout
     end subroutine amg_s_base_onelev_descr
   end interface
 
-  interface
-    subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
-      Implicit None
-      ! Arguments
-      class(amg_s_onelev_type), intent(in)    :: lv
-      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_s_base_onelev_memory_use
-  end interface
-
-  interface
+  interface 
     subroutine amg_s_base_onelev_cnv(lv,info,amold,vmold,imold)
       import :: amg_s_onelev_type, psb_s_base_vect_type, psb_spk_, &
            & psb_s_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
       ! Arguments
-      class(amg_s_onelev_type), intent(inout)            :: lv
+      class(amg_s_onelev_type), intent(inout)            :: lv 
       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
     end subroutine amg_s_base_onelev_cnv
   end interface
-
-  interface
+   
+interface 
     subroutine amg_s_base_onelev_free(lv,info)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
            & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
-      implicit none
-
+      implicit none 
+      
       class(amg_s_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_s_base_onelev_free
   end interface
-
-  interface
-    subroutine amg_s_base_onelev_free_smoothers(lv,info)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
-      implicit none
-
-      class(amg_s_onelev_type), intent(inout) :: lv
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_s_base_onelev_free_smoothers
-  end interface
-
-  interface
+  
+  interface 
     subroutine amg_s_base_onelev_check(lv,info)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
            & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
       ! Arguments
-      class(amg_s_onelev_type), intent(inout) :: lv
+      class(amg_s_onelev_type), intent(inout) :: lv 
       integer(psb_ipk_), intent(out)            :: info
     end subroutine amg_s_base_onelev_check
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_s_base_onelev_setsm(lv,val,info,pos)
       import :: psb_spk_, amg_s_onelev_type, amg_s_base_smoother_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
+      
       ! Arguments
-      class(amg_s_onelev_type), target, intent(inout) :: lv
+      class(amg_s_onelev_type), target, intent(inout) :: lv 
       class(amg_s_base_smoother_type), intent(in)     :: val
       integer(psb_ipk_), intent(out)                  :: info
       character(len=*), optional, intent(in)          :: pos
     end subroutine amg_s_base_onelev_setsm
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_s_base_onelev_setsv(lv,val,info,pos)
       import :: psb_spk_, amg_s_onelev_type, amg_s_base_solver_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
+      
       ! Arguments
-      class(amg_s_onelev_type), target, intent(inout) :: lv
+      class(amg_s_onelev_type), target, intent(inout) :: lv 
       class(amg_s_base_solver_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
       character(len=*), optional, intent(in)          :: pos
     end subroutine amg_s_base_onelev_setsv
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_s_base_onelev_setag(lv,val,info,pos)
       import :: psb_spk_, amg_s_onelev_type, amg_s_base_aggregator_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
+      
       ! Arguments
-      class(amg_s_onelev_type), target, intent(inout) :: lv
+      class(amg_s_onelev_type), target, intent(inout) :: lv 
       class(amg_s_base_aggregator_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
       character(len=*), optional, intent(in)          :: pos
     end subroutine amg_s_base_onelev_setag
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
            & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
+      
       ! Arguments
-      class(amg_s_onelev_type), intent(inout) :: lv
-      character(len=*), intent(in)              :: what
+      class(amg_s_onelev_type), intent(inout) :: lv 
+      character(len=*), intent(in)              :: what 
       integer(psb_ipk_), intent(in)             :: val
       integer(psb_ipk_), intent(out)            :: info
       character(len=*), optional, intent(in)      :: pos
     integer(psb_ipk_), intent(in), optional       :: idx
     end subroutine amg_s_base_onelev_cseti
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
            & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
       ! Arguments
-      class(amg_s_onelev_type), intent(inout) :: lv
-      character(len=*), intent(in)              :: what
+      class(amg_s_onelev_type), intent(inout) :: lv 
+      character(len=*), intent(in)              :: what 
       character(len=*), intent(in)              :: val
       integer(psb_ipk_), intent(out)            :: info
       character(len=*), optional, intent(in)      :: pos
     integer(psb_ipk_), intent(in), optional       :: idx
     end subroutine amg_s_base_onelev_csetc
   end interface
-
-  interface
+  
+  interface 
     subroutine amg_s_base_onelev_csetr(lv,what,val,info,pos,idx)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
            & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
-
-      class(amg_s_onelev_type), intent(inout) :: lv
-      character(len=*), intent(in)              :: what
+      
+      class(amg_s_onelev_type), intent(inout) :: lv 
+      character(len=*), intent(in)              :: what 
       real(psb_spk_), intent(in)                 :: val
       integer(psb_ipk_), intent(out)            :: info
       character(len=*), optional, intent(in)      :: pos
@@ -432,13 +380,13 @@ module amg_s_onelev_mod
     end subroutine amg_s_base_onelev_csetr
   end interface
 
-  interface
+  interface 
     subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
          & solver,tprol,global_num)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
            & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
-      implicit none
+      implicit none 
       class(amg_s_onelev_type), intent(in) :: lv
       integer(psb_ipk_), intent(in)          :: level
       integer(psb_ipk_), intent(out)         :: info
@@ -446,62 +394,15 @@ module amg_s_onelev_mod
       logical, optional, intent(in)    :: ac, rp, smoother, solver, tprol, global_num
     end subroutine amg_s_base_onelev_dump
   end interface
-
-  interface
-    subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
-      import
-      implicit none
-      class(amg_s_onelev_type), target, intent(inout) :: lv
-      real(psb_spk_), intent(in)     :: alpha, beta
-      real(psb_spk_), intent(inout)   :: u(:)
-      real(psb_spk_), intent(out)     :: v(:)
-      integer(psb_ipk_), intent(out) :: info
-      real(psb_spk_), optional       :: work(:)
-    end subroutine amg_s_base_onelev_map_rstr_a
-    subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
-      import
-      implicit none
-      class(amg_s_onelev_type), target, intent(inout) :: lv
-      real(psb_spk_), intent(in)           :: alpha, beta
-      type(psb_s_vect_type), intent(inout) :: vect_u, vect_v
-      integer(psb_ipk_), intent(out)       :: info
-      real(psb_spk_), optional          :: work(:)
-      type(psb_s_vect_type), optional, target, intent(inout)  :: vtx,vty
-    end subroutine amg_s_base_onelev_map_rstr_v
-  end interface
-
-  interface
-    subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
-      import
-      implicit none
-      class(amg_s_onelev_type), target, intent(inout) :: lv
-      real(psb_spk_), intent(in)     :: alpha, beta
-      real(psb_spk_), intent(inout)   :: u(:)
-      real(psb_spk_), intent(out)     :: v(:)
-      integer(psb_ipk_), intent(out) :: info
-      real(psb_spk_), optional          :: work(:)
-
-    end subroutine amg_s_base_onelev_map_prol_a
-    subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
-      import
-      implicit none
-      class(amg_s_onelev_type), target, intent(inout) :: lv
-      real(psb_spk_), intent(in)           :: alpha, beta
-      type(psb_s_vect_type), intent(inout) :: vect_u, vect_v
-      integer(psb_ipk_), intent(out)       :: info
-      real(psb_spk_), optional          :: work(:)
-      type(psb_s_vect_type), optional, target, intent(inout)  :: vtx,vty
-    end subroutine amg_s_base_onelev_map_prol_v
-  end interface
-
+  
 contains
   !
   ! Function returning the size of the amg_prec_type data structure
-  ! in bytes or in number of nonzeros of the operator(s) involved.
+  ! in bytes or in number of nonzeros of the operator(s) involved. 
   !
 
   function s_base_onelev_get_nzeros(lv) result(val)
-    implicit none
+    implicit none 
     class(amg_s_onelev_type), intent(in) :: lv
     integer(psb_epk_) :: val
     integer(psb_ipk_)        :: i
@@ -513,16 +414,16 @@ contains
   end function s_base_onelev_get_nzeros
 
   function s_base_onelev_sizeof(lv) result(val)
-    implicit none
+    implicit none 
     class(amg_s_onelev_type), intent(in) :: lv
     integer(psb_epk_) :: val
     integer(psb_ipk_)        :: i
-
+    
     val = psb_sizeof_ip+psb_sizeof_lp
     val = val + lv%desc_ac%sizeof()
     val = val + lv%ac%sizeof()
     val = val + lv%tprol%sizeof()
-    val = val + lv%linmap%sizeof()
+    val = val + lv%map%sizeof() 
     if (allocated(lv%sm))   val = val + lv%sm%sizeof()
     if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
     if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -531,19 +432,19 @@ contains
 
 
   subroutine s_base_onelev_nullify(lv)
-    implicit none
+    implicit none 
 
     class(amg_s_onelev_type), intent(inout) :: lv
 
-    nullify(lv%base_a)
-    nullify(lv%base_desc)
+    nullify(lv%base_a) 
+    nullify(lv%base_desc) 
     nullify(lv%sm2)
   end subroutine s_base_onelev_nullify
 
   !
-  ! Multilevel defaults:
+  ! Multilevel defaults: 
   !  multiplicative vs. additive ML framework;
-  !  Smoothed decoupled aggregation with zero threshold;
+  !  Smoothed decoupled aggregation with zero threshold; 
   !  distributed coarse matrix;
   !  damping omega  computed with the max-norm estimate of the
   !  dominant eigenvalue;
@@ -553,10 +454,10 @@ contains
   subroutine s_base_onelev_default(lv)
 
     Implicit None
-
+ 
     ! Arguments
     class(amg_s_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_) :: info
+    integer(psb_ipk_) :: info 
 
     lv%parms%sweeps_pre      = 1
     lv%parms%sweeps_post     = 1
@@ -571,7 +472,7 @@ contains
     lv%parms%aggr_filter     = amg_no_filter_mat_
     lv%parms%aggr_omega_val  = szero
     lv%parms%aggr_thresh     = 0.01_psb_spk_
-
+    
     if (allocated(lv%sm)) call lv%sm%default()
     if (allocated(lv%sm2a)) then
       call lv%sm2a%default()
@@ -581,7 +482,7 @@ contains
     end if
     if (.not.allocated(lv%aggr)) allocate(amg_s_dec_aggregator_type :: lv%aggr,stat=info)
     if (allocated(lv%aggr)) call lv%aggr%default()
-
+    
     return
 
   end subroutine s_base_onelev_default
@@ -596,9 +497,9 @@ contains
     type(psb_lsspmat_type), intent(out)  :: t_prol
     type(amg_saggr_data), intent(in)    :: ag_data
     integer(psb_ipk_), intent(out)      :: info
-
+    
     call lv%aggr%bld_tprol(lv%parms,ag_data,a,desc_a,ilaggr,nlaggr,t_prol,info)
-
+    
   end subroutine s_base_onelev_bld_tprol
 
 
@@ -608,7 +509,7 @@ contains
     integer(psb_ipk_), intent(out)      :: info
 
     call lv%aggr%update_next(lvnext%aggr,info)
-
+    
   end subroutine s_base_onelev_update_aggr
 
 
@@ -617,33 +518,33 @@ contains
     Implicit None
 
     ! Arguments
-    class(amg_s_onelev_type), target, intent(inout) :: lv
+    class(amg_s_onelev_type), target, intent(inout) :: lv 
     class(amg_s_onelev_type), target, intent(inout) :: lvout
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
 
     info = psb_success_
-    if (allocated(lv%sm)) then
+    if (allocated(lv%sm)) then 
       call lv%sm%clone(lvout%sm,info)
-    else
-      if (allocated(lvout%sm)) then
+    else 
+      if (allocated(lvout%sm)) then 
         call lvout%sm%free(info)
         if (info==psb_success_) deallocate(lvout%sm,stat=info)
       end if
     end if
-    if (allocated(lv%sm2a)) then
+    if (allocated(lv%sm2a)) then 
       call lv%sm%clone(lvout%sm2a,info)
       lvout%sm2 => lvout%sm2a
-    else
-      if (allocated(lvout%sm2a)) then
+    else 
+      if (allocated(lvout%sm2a)) then 
         call lvout%sm2a%free(info)
         if (info==psb_success_) deallocate(lvout%sm2a,stat=info)
       end if
       lvout%sm2 => lvout%sm
     end if
-    if (allocated(lv%aggr)) then
+    if (allocated(lv%aggr)) then 
       call  lv%aggr%clone(lvout%aggr,info)
     else
-      if (allocated(lvout%aggr)) then
+      if (allocated(lvout%aggr)) then 
         call lvout%aggr%free(info)
         if (info==psb_success_) deallocate(lvout%aggr,stat=info)
       end if
@@ -652,11 +553,10 @@ contains
     if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
     if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
     if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
-    if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
-    if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
+    if (info == psb_success_) call lv%map%clone(lvout%map,info)
     lvout%base_a    => lv%base_a
     lvout%base_desc => lv%base_desc
-
+    
     return
 
   end subroutine s_base_onelev_clone
@@ -665,12 +565,12 @@ contains
     use psb_base_mod
     implicit none
     class(amg_s_onelev_type), target, intent(inout) :: lv, b
-    integer(psb_ipk_), intent(out) :: info
-
+    integer(psb_ipk_), intent(out) :: info 
+    
     call b%free(info)
     b%parms  = lv%parms
     b%szratio = lv%szratio
-    if (associated(lv%sm2,lv%sm2a)) then
+    if (associated(lv%sm2,lv%sm2a)) then 
       call move_alloc(lv%sm,b%sm)
       call move_alloc(lv%sm2a,b%sm2a)
       b%sm2 =>b%sm2a
@@ -681,18 +581,18 @@ contains
     end if
 
     call move_alloc(lv%aggr,b%aggr)
-    if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
-    if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
-    if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
-    if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
+    if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info) 
+    if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info) 
+    if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info) 
+    if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info) 
     b%base_a    => lv%base_a
     b%base_desc => lv%base_desc
-
+    
   end subroutine s_base_onelev_move_alloc
 
-
+  
   function s_base_onelev_get_wrksize(lv) result(val)
-    implicit none
+    implicit none 
     class(amg_s_onelev_type), intent(inout) :: lv
     integer(psb_ipk_)  :: val
 
@@ -713,54 +613,44 @@ contains
     select case(lv%parms%ml_cycle)
     case(amg_add_ml_,amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
       ! We're good
-
+      
     case(amg_kcycle_ml_, amg_kcyclesym_ml_)
       !
       ! We need 7 in inneritkcycle.
-      !  Can we reuse vtx?
-      !
+      !  Can we reuse vtx? 
+      ! 
       val = val + 7
-
+      
     case default
       ! Need a better error signaling ?
       val = -1
     end select
-
+    
   end function s_base_onelev_get_wrksize
 
   subroutine s_base_onelev_allocate_wrk(lv,info,vmold)
     use psb_base_mod
     implicit none
     class(amg_s_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
+    integer(psb_ipk_), intent(out) :: info 
     class(psb_s_base_vect_type), intent(in), optional  :: vmold
     !
     integer(psb_ipk_) :: nwv, i
     info = psb_success_
     nwv = lv%get_wrksz()
     if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
-    if (info == 0) then
-      if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
-        !
-        !  Need to fix this, we need two different allocations
-        !
-        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
-             & desc2=lv%remap_data%desc_ac_pre_remap)
-      else
-        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
-      end if
-    end if
-
+    if (info == 0) call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
+    
   end subroutine s_base_onelev_allocate_wrk
 
-
+  
   subroutine s_base_onelev_free_wrk(lv,info)
     use psb_base_mod
     implicit none
     class(amg_s_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
+    integer(psb_ipk_), intent(out) :: info 
     !
-    integer(psb_ipk_) :: nwv,i
+    integer(psb_ipk_) :: nwv,i 
     info = psb_success_
 
     if (allocated(lv%wrk)) then
@@ -768,88 +658,46 @@ contains
       if (info == 0) deallocate(lv%wrk,stat=info)
     end if
   end subroutine s_base_onelev_free_wrk
-
-  subroutine s_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
+  
+  subroutine s_wrk_alloc(wk,nwv,desc,info,vmold)
     use psb_base_mod
-
+    
     Implicit None
-
+    
     ! Arguments
     class(amg_smlprec_wrk_type), target, intent(inout) :: wk
     integer(psb_ipk_), intent(in)                     :: nwv
     type(psb_desc_type), intent(in)                   :: desc
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
     class(psb_s_base_vect_type), intent(in), optional  :: vmold
-    type(psb_desc_type), intent(in), optional          :: desc2
     !
     integer(psb_ipk_) :: i
 
     info = psb_success_
     call wk%free(info)
-    if  (present(desc2)) then
-!!$      write(0,*) 'Check on wrk_alloc 2',&
-!!$           & desc2%get_local_rows(), desc%get_local_rows(),&
-!!$           & desc2%get_local_cols(),desc%get_local_cols()
-!!$      flush(0)
-      if (desc2%get_local_cols()>desc%get_local_cols()) then
-        call psb_geasb(wk%vx2l,desc2,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vy2l,desc2,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vtx,desc2,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vty,desc2,info,&
-             & scratch=.true.,mold=vmold)
-        allocate(wk%wv(nwv),stat=info)
-        do i=1,nwv
-          call psb_geasb(wk%wv(i),desc2,info,&
-               & scratch=.true.,mold=vmold)
-        end do
-      else
-!!$        write(0,*) 'Check on wrk_alloc 1.5 ',&
-!!$             & desc%get_local_rows(),&
-!!$             & desc%get_local_cols()
-        call psb_geasb(wk%vx2l,desc,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vy2l,desc,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vtx,desc,info,&
-             & scratch=.true.,mold=vmold)
-        call psb_geasb(wk%vty,desc,info,&
-             & scratch=.true.,mold=vmold)
-        allocate(wk%wv(nwv),stat=info)
-        do i=1,nwv
-          call psb_geasb(wk%wv(i),desc,info,&
-               & scratch=.true.,mold=vmold)
-        end do
-      end if
-    else
-!!$      write(0,*) 'Check on wrk_alloc 1 ',&
-!!$           & desc%get_local_rows(),&
-!!$           & desc%get_local_cols()
-      call psb_geasb(wk%vx2l,desc,info,&
+    call psb_geasb(wk%vx2l,desc,info,&
+         & scratch=.true.,mold=vmold)
+    call psb_geasb(wk%vy2l,desc,info,&
+         & scratch=.true.,mold=vmold)
+    call psb_geasb(wk%vtx,desc,info,&
+         & scratch=.true.,mold=vmold)
+    call psb_geasb(wk%vty,desc,info,&
+         & scratch=.true.,mold=vmold)
+    allocate(wk%wv(nwv),stat=info)
+    do i=1,nwv
+      call psb_geasb(wk%wv(i),desc,info,&
            & scratch=.true.,mold=vmold)
-      call psb_geasb(wk%vy2l,desc,info,&
-           & scratch=.true.,mold=vmold)
-      call psb_geasb(wk%vtx,desc,info,&
-           & scratch=.true.,mold=vmold)
-      call psb_geasb(wk%vty,desc,info,&
-           & scratch=.true.,mold=vmold)
-      allocate(wk%wv(nwv),stat=info)
-      do i=1,nwv
-        call psb_geasb(wk%wv(i),desc,info,&
-             & scratch=.true.,mold=vmold)
-      end do
-    end if
+    end do
+    
   end subroutine s_wrk_alloc
-
+    
   subroutine s_wrk_free(wk,info)
 
     Implicit None
 
     ! Arguments
     class(amg_smlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
     !
     integer(psb_ipk_) :: i
     info = psb_success_
@@ -870,7 +718,7 @@ contains
     end if
 
   end subroutine s_wrk_free
-
+    
   subroutine s_wrk_clone(wk,wkout,info)
     use psb_base_mod
     Implicit None
@@ -878,11 +726,11 @@ contains
     ! Arguments
     class(amg_smlprec_wrk_type), target, intent(inout) :: wk
     class(amg_smlprec_wrk_type), target, intent(inout) :: wkout
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
     !
     integer(psb_ipk_) :: i
     info = psb_success_
-
+    
     call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
     call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
     call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
@@ -904,12 +752,12 @@ contains
     return
 
   end subroutine s_wrk_clone
-
+  
   subroutine s_wrk_move_alloc(wk, b,info)
     implicit none
     class(amg_smlprec_wrk_type), target, intent(inout) :: wk, b
-    integer(psb_ipk_), intent(out) :: info
-
+    integer(psb_ipk_), intent(out) :: info 
+    
     call b%free(info)
     call move_alloc(wk%tx,b%tx)
     call move_alloc(wk%ty,b%ty)
@@ -922,17 +770,17 @@ contains
     call move_alloc(wk%vx2l%v,b%vx2l%v)
     call move_alloc(wk%vy2l%v,b%vy2l%v)
     call move_alloc(wk%wv,b%wv)
-
+        
   end subroutine s_wrk_move_alloc
 
   subroutine s_wrk_cnv(wk,info,vmold)
     use psb_base_mod
-
+    
     Implicit None
-
+    
     ! Arguments
     class(amg_smlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                    :: info 
     class(psb_s_base_vect_type), intent(in), optional  :: vmold
     !
     integer(psb_ipk_) :: i
@@ -953,7 +801,7 @@ contains
 
   function s_wrk_sizeof(wk) result(val)
     use psb_realloc_mod
-    implicit none
+    implicit none 
     class(amg_smlprec_wrk_type), intent(in) :: wk
     integer(psb_epk_) :: val
     integer :: i
@@ -972,25 +820,5 @@ contains
       end do
     end if
   end function s_wrk_sizeof
-
-  subroutine s_remap_data_clone(rmp, remap_out, info)
-    use psb_base_mod
-    implicit none
-    ! Arguments
-    class(amg_s_remap_data_type), target, intent(inout) :: rmp
-    class(amg_s_remap_data_type), target, intent(inout) :: remap_out
-    integer(psb_ipk_), intent(out)                    :: info
-    !
-    integer(psb_ipk_) :: i
-
-    info = psb_success_
-
-    call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
-    if (info == psb_success_) &
-         & call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
-    remap_out%idest = rmp%idest
-    call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
-    call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
-  end subroutine s_remap_data_clone
-
+ 
 end module amg_s_onelev_mod

amgprec/amg_s_parmatch_aggregator_mod.F90

@@ -1,689 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-! moved here from amg4psblas-extension
-!
-!
-!                             AMG4PSBLAS  Extensions
-!
-!    (C) Copyright 2019
-!
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-!
-!
-!  The aggregator object hosts the aggregation method for building
-!  the multilevel hierarchy. This variant is based on the hybrid method
-!  presented in
-!
-!
-!   sm           -  class(amg_T_base_smoother_type), allocatable
-!                   The current level preconditioner (aka smoother).
-!   parms        -  type(amg_RTml_parms)
-!                   The parameters defining the multilevel strategy.
-!   ac           -  The local part of the current-level matrix, built by
-!                   coarsening the previous-level matrix.
-!   desc_ac      -  type(psb_desc_type).
-!                   The communication descriptor associated to the matrix
-!                   stored in ac.
-!   base_a       -  type(psb_Tspmat_type), pointer.
-!                   Pointer (really a pointer!) to the local part of the current
-!                   matrix (so we have a unified treatment of residuals).
-!                   We need this to avoid passing explicitly the current matrix
-!                   to the routine which applies the preconditioner.
-!   base_desc    -  type(psb_desc_type), pointer.
-!                   Pointer to the communication descriptor associated to the
-!                   matrix pointed by base_a.
-!   map          -  Stores the maps (restriction and prolongation) between the
-!                   vector spaces associated to the index spaces of the previous
-!                   and current levels.
-!
-!   Methods:
-!     Most methods follow the encapsulation hierarchy: they take whatever action
-!     is appropriate for the current object, then call the corresponding method for
-!     the contained object.
-!     As an example: the descr() method prints out a description of the
-!     level. It starts by invoking the descr() method of the parms object,
-!     then calls the descr() method of the smoother object.
-!
-!    descr      -   Prints a description of the object.
-!    default    -   Set default values
-!    dump       -   Dump to file object contents
-!    set        -   Sets various parameters; when a request is unknown
-!                   it is passed to the smoother object for further processing.
-!    check      -   Sanity checks.
-!    sizeof     -   Total memory occupation in bytes
-!    get_nzeros -   Number of nonzeros
-!
-!
-
-module amg_s_parmatch_aggregator_mod
-  use amg_s_base_aggregator_mod
-  use amg_s_matchboxp_mod
-#if defined(SERIAL_MPI)
-  type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
-  end type amg_s_parmatch_aggregator_type
-#else 
-  type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
-    integer(psb_ipk_) :: matching_alg
-    integer(psb_ipk_) :: n_sweeps   ! When n_sweeps >1 we need an auxiliary descriptor
-    integer(psb_ipk_) :: orig_aggr_size
-    integer(psb_ipk_) :: jacobi_sweeps
-    real(psb_spk_), allocatable :: w(:), w_nxt(:)
-    type(psb_sspmat_type), allocatable  :: prol, restr
-    type(psb_sspmat_type), allocatable  :: ac, base_a, rwa
-    type(psb_desc_type), allocatable    :: desc_ac, desc_ax, base_desc, rwdesc
-    logical           :: reproducible_matching = .false.
-    logical           :: need_symmetrize       = .false.
-    logical           :: unsmoothed_hierarchy  = .true.
-  contains
-    procedure, pass(ag) :: bld_tprol    => amg_s_parmatch_aggregator_build_tprol
-    procedure, pass(ag) :: mat_bld      => amg_s_parmatch_aggregator_mat_bld
-    procedure, pass(ag) :: mat_asb      => amg_s_parmatch_aggregator_mat_asb
-    procedure, pass(ag) :: inner_mat_asb      => amg_s_parmatch_aggregator_inner_mat_asb
-    procedure, pass(ag) :: bld_map      => amg_s_parmatch_aggregator_bld_map
-    procedure, pass(ag) :: csetc        => amg_s_parmatch_aggr_csetc
-    procedure, pass(ag) :: cseti        => amg_s_parmatch_aggr_cseti
-    procedure, pass(ag) :: default      => amg_s_parmatch_aggr_set_default
-    procedure, pass(ag) :: sizeof       => amg_s_parmatch_aggregator_sizeof
-    procedure, pass(ag) :: update_next  => amg_s_parmatch_aggregator_update_next
-    procedure, pass(ag) :: bld_wnxt     => amg_s_parmatch_bld_wnxt
-    procedure, pass(ag) :: bld_default_w    => amg_s_bld_default_w
-    procedure, pass(ag) :: set_c_default_w  => amg_s_set_prm_c_default_w
-    procedure, pass(ag) :: descr        => amg_s_parmatch_aggregator_descr
-    procedure, pass(ag) :: clone        => amg_s_parmatch_aggregator_clone
-    procedure, pass(ag) :: free         => amg_s_parmatch_aggregator_free
-    procedure, nopass   :: fmt          => amg_s_parmatch_aggregator_fmt
-    procedure, nopass   :: xt_desc      => amg_s_parmatch_aggregator_xt_desc
-  end type amg_s_parmatch_aggregator_type
-
-  interface
-    subroutine  amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
-         & a,desc_a,ilaggr,nlaggr,t_prol,info)
-      import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
-           & psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
-      implicit none
-      class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
-      type(amg_sml_parms), intent(inout)   :: parms
-      type(amg_saggr_data), intent(in)     :: ag_data
-      type(psb_sspmat_type), intent(inout) :: a
-      type(psb_desc_type), intent(inout)     :: desc_a
-      integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
-      type(psb_lsspmat_type), intent(out)  :: t_prol
-      integer(psb_ipk_), intent(out)      :: info
-    end subroutine amg_s_parmatch_aggregator_build_tprol
-  end interface
-
-  interface
-    subroutine  amg_s_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
-           & psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
-      implicit none
-      class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
-      type(amg_sml_parms), intent(inout)   :: parms
-      type(psb_sspmat_type), intent(in)    :: a
-      type(psb_desc_type), intent(inout)   :: desc_a
-      integer(psb_lpk_), intent(inout)     :: ilaggr(:), nlaggr(:)
-      type(psb_lsspmat_type), intent(inout)   :: t_prol
-      type(psb_sspmat_type), intent(out)   ::  op_prol,ac,op_restr
-      type(psb_desc_type), intent(inout)    :: desc_ac
-      integer(psb_ipk_), intent(out)       :: info
-    end subroutine amg_s_parmatch_aggregator_mat_bld
-  end interface
-
-  interface
-    subroutine  amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
-         & ac,desc_ac, op_prol,op_restr,info)
-      import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
-           & psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
-      implicit none
-      class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
-      type(amg_sml_parms), intent(inout)    :: parms
-      type(psb_sspmat_type), intent(in)     :: a
-      type(psb_desc_type), intent(inout)    :: desc_a
-      type(psb_sspmat_type), intent(inout) :: op_prol,ac,op_restr
-      type(psb_desc_type), intent(inout)    :: desc_ac
-      integer(psb_ipk_), intent(out)        :: info
-    end subroutine amg_s_parmatch_aggregator_mat_asb
-  end interface
-
-
-  interface
-    subroutine  amg_s_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
-         & ac,desc_ac, op_prol,op_restr,info)
-      import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
-           & psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
-      implicit none
-      class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
-      type(amg_sml_parms), intent(inout)    :: parms
-      type(psb_sspmat_type), intent(in)     :: a
-      type(psb_desc_type), intent(in)       :: desc_a
-      type(psb_sspmat_type), intent(inout) :: op_prol,op_restr
-      type(psb_sspmat_type), intent(inout)  :: ac
-      type(psb_desc_type), intent(inout)    :: desc_ac
-      integer(psb_ipk_), intent(out)        :: info
-    end subroutine amg_s_parmatch_aggregator_inner_mat_asb
-  end interface
-
-
-  interface
-    subroutine amg_s_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
-           & psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
-      implicit none
-      type(psb_sspmat_type), intent(in)       :: a
-      type(psb_desc_type), intent(inout)       :: desc_a
-      integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-      type(amg_sml_parms), intent(inout)      :: parms
-      type(psb_lsspmat_type), intent(inout)   :: t_prol
-      type(psb_sspmat_type), intent(inout)    :: ac, op_prol, op_restr
-      type(psb_desc_type), intent(out)        :: desc_ac
-      integer(psb_ipk_), intent(out)          :: info
-    end subroutine amg_s_parmatch_spmm_bld
-  end interface
-
-  interface
-    subroutine amg_s_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
-           & psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
-      implicit none
-      class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
-      type(psb_sspmat_type), intent(in)       :: a
-      type(psb_desc_type), intent(inout)      :: desc_a
-      integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-      type(amg_sml_parms), intent(inout)      :: parms
-      type(psb_lsspmat_type), intent(inout)   :: t_prol
-      type(psb_sspmat_type), intent(inout)      :: op_prol,ac, op_restr
-      type(psb_desc_type), intent(inout)    :: desc_ac
-      integer(psb_ipk_), intent(out)          :: info
-    end subroutine amg_s_parmatch_unsmth_bld
-  end interface
-
-  interface
-    subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
-           & psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
-      implicit none
-      class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
-      type(psb_sspmat_type), intent(in)       :: a
-      type(psb_desc_type), intent(inout)      :: desc_a
-      integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-      type(amg_sml_parms), intent(inout)      :: parms
-      type(psb_lsspmat_type), intent(inout)   :: t_prol
-      type(psb_sspmat_type), intent(inout)    :: op_prol,ac, op_restr
-      type(psb_desc_type), intent(inout)    :: desc_ac
-      integer(psb_ipk_), intent(out)          :: info
-    end subroutine amg_s_parmatch_smth_bld
-  end interface
-
-  interface
-    subroutine amg_s_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
-           & psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
-      implicit none
-      type(psb_sspmat_type), intent(inout)    :: a
-      type(psb_desc_type), intent(inout)       :: desc_a
-      integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-      type(amg_sml_parms), intent(inout)      :: parms
-      type(psb_lsspmat_type), intent(inout)   :: t_prol
-      type(psb_sspmat_type), intent(inout)    :: op_prol,ac, op_restr
-      type(psb_desc_type), intent(out)          :: desc_ac
-      integer(psb_ipk_), intent(out)          :: info
-    end subroutine amg_s_parmatch_spmm_bld_ov
-  end interface
-
-  interface
-    subroutine amg_s_parmatch_spmm_bld_inner(a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
-           & psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data,&
-           & psb_s_csr_sparse_mat, psb_ls_csr_sparse_mat
-      implicit none
-      type(psb_s_csr_sparse_mat), intent(inout) :: a
-      type(psb_desc_type), intent(inout)          :: desc_a
-      integer(psb_lpk_), intent(inout)          :: ilaggr(:), nlaggr(:)
-      type(amg_sml_parms), intent(inout)        :: parms
-      type(psb_lsspmat_type), intent(inout)     :: t_prol
-      type(psb_sspmat_type), intent(inout)      :: op_prol,ac, op_restr
-      type(psb_desc_type), intent(out)          :: desc_ac
-      integer(psb_ipk_), intent(out)            :: info
-    end subroutine amg_s_parmatch_spmm_bld_inner
-  end interface
-
-  private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels
-
-contains
-
-  subroutine amg_s_bld_default_w(ag,nr)
-    use psb_realloc_mod
-    implicit none
-    class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
-    integer(psb_ipk_), intent(in) :: nr
-    integer(psb_ipk_) :: info
-    call psb_realloc(nr,ag%w,info)
-    if (info /= psb_success_) return
-    ag%w = done
-    !call ag%set_c_default_w()
-  end subroutine amg_s_bld_default_w
-
-  subroutine amg_s_set_prm_c_default_w(ag)
-    use psb_realloc_mod
-    use iso_c_binding
-    implicit none
-    class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
-    integer(psb_ipk_) :: info
-
-    !write(0,*) 'prm_c_deafult_w '
-    call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
-
-  end subroutine amg_s_set_prm_c_default_w
-
-  subroutine amg_s_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
-    use psb_realloc_mod
-    implicit none
-    class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
-    integer(psb_lpk_), intent(in)  :: ilaggr(:)
-    real(psb_spk_), intent(in)     :: valaggr(:)
-    integer(psb_ipk_), intent(in)  :: nx
-
-    integer(psb_ipk_) :: info,i,j
-
-    ! The vector was already fixed in the call to BCMatch.
-    !write(0,*) 'Executing bld_wnxt ',nx
-    call psb_realloc(nx,ag%w_nxt,info)
-
-  end subroutine amg_s_parmatch_bld_wnxt
-
-  function amg_s_parmatch_aggregator_fmt() result(val)
-    implicit none
-    character(len=32)  :: val
-
-    val = "Parallel Matching aggregation"
-  end function amg_s_parmatch_aggregator_fmt
-
-  function amg_s_parmatch_aggregator_xt_desc() result(val)
-    implicit none
-    logical  :: val
-
-    val = .true.
-  end function amg_s_parmatch_aggregator_xt_desc
-
-  function amg_s_parmatch_aggregator_sizeof(ag) result(val)
-    use psb_realloc_mod
-    implicit none
-    class(amg_s_parmatch_aggregator_type), intent(in)  :: ag
-    integer(psb_epk_)  :: val
-
-    val = 4
-    val = val + psb_size(ag%w) + psb_size(ag%w_nxt)
-    if (allocated(ag%ac))      val = val + ag%ac%sizeof()
-    if (allocated(ag%base_a))  val = val + ag%base_a%sizeof()
-    if (allocated(ag%prol))    val = val + ag%prol%sizeof()
-    if (allocated(ag%restr))   val = val + ag%restr%sizeof()
-    if (allocated(ag%desc_ac)) val = val + ag%desc_ac%sizeof()
-    if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
-    if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
-
-  end function amg_s_parmatch_aggregator_sizeof
-
-  subroutine  amg_s_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
-    implicit none
-    class(amg_s_parmatch_aggregator_type), intent(in) :: ag
-    type(amg_sml_parms), intent(in)   :: parms
-    integer(psb_ipk_), intent(in)  :: iout
-    integer(psb_ipk_), intent(out) :: info
-    character(len=*), intent(in), optional  :: prefix
-    character(1024)    :: prefix_
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
-    write(iout,*) trim(prefix_),' ','   Number of matching  sweeps: ',ag%n_sweeps
-    write(iout,*) trim(prefix_),' ','   Matching algorithm         : MatchBoxP (PREIS)'
-    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info,prefix=prefix)
-
-    return
-  end subroutine amg_s_parmatch_aggregator_descr
-
-  function is_legal_malg(alg) result(val)
-    logical :: val
-    integer(psb_ipk_) :: alg
-
-    val = (0==alg)
-  end function is_legal_malg
-
-  function is_legal_csize(csize) result(val)
-    logical :: val
-    integer(psb_ipk_) :: csize
-
-    val = ((-1==csize).or.(csize >0))
-  end function is_legal_csize
-
-  function is_legal_nsweeps(nsw) result(val)
-    logical :: val
-    integer(psb_ipk_) :: nsw
-
-    val = (1<=nsw)
-  end function is_legal_nsweeps
-
-  function is_legal_nlevels(nlv) result(val)
-    logical :: val
-    integer(psb_ipk_) :: nlv
-
-    val = (1<=nlv)
-  end function is_legal_nlevels
-
-
-  subroutine  amg_s_parmatch_aggregator_update_next(ag,agnext,info)
-    use psb_realloc_mod
-    implicit none
-    class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
-    class(amg_s_base_aggregator_type), target, intent(inout) :: agnext
-    integer(psb_ipk_), intent(out)       :: info
-
-    !
-    !
-    select type(agnext)
-    class is (amg_s_parmatch_aggregator_type)
-      if (.not.is_legal_malg(agnext%matching_alg)) &
-           & agnext%matching_alg = ag%matching_alg
-      if (.not.is_legal_nsweeps(agnext%n_sweeps))&
-           & agnext%n_sweeps     = ag%n_sweeps
-!!$      if (.not.is_legal_csize(agnext%max_csize))&
-!!$           & agnext%max_csize    = ag%max_csize
-!!$      if (.not.is_legal_nlevels(agnext%max_nlevels))&
-!!$           & agnext%max_nlevels  = ag%max_nlevels
-      ! Is this going to generate shallow copies/memory leaks/double frees?
-      ! To be investigated further.
-      call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
-      call agnext%set_c_default_w()
-      if (ag%unsmoothed_hierarchy) then
-        agnext%unsmoothed_hierarchy = .true.
-        call move_alloc(ag%rwdesc,agnext%base_desc)
-        call move_alloc(ag%rwa,agnext%base_a)
-      end if
-
-    class default
-      ! What should we do here?
-    end select
-    info = 0
-  end subroutine amg_s_parmatch_aggregator_update_next
-
-  subroutine amg_s_parmatch_aggr_csetc(ag,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
-    character(len=*), intent(in)                  :: what
-    character(len=*), intent(in)                 :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act, iwhat
-    character(len=20)  :: name='s_parmatch_aggr_cseti'
-    info = psb_success_
-
-    ! For now we ignore IDX
-
-    select case(psb_toupper(trim(what)))
-    case('PRMC_REPRODUCIBLE_MATCHING')
-      select case(psb_toupper(trim(val)))
-      case('F','FALSE')
-        ag%reproducible_matching = .false.
-      case('REPRODUCIBLE','TRUE','T')
-        ag%reproducible_matching =.true.
-      end select
-    case('PRMC_NEED_SYMMETRIZE')
-      select case(psb_toupper(trim(val)))
-      case('FALSE','F')
-        ag%need_symmetrize = .false.
-      case('SYMMETRIZE','TRUE','T')
-        ag%need_symmetrize =.true.
-      end select
-    case('PRMC_UNSMOOTHED_HIERARCHY')
-      select case(psb_toupper(trim(val)))
-      case('F','FALSE')
-        ag%unsmoothed_hierarchy = .false.
-      case('T','TRUE')
-        ag%unsmoothed_hierarchy =.true.
-      end select
-    case default
-      ! Do nothing
-    end select
-    return
-  end subroutine amg_s_parmatch_aggr_csetc
-
-  subroutine amg_s_parmatch_aggr_cseti(ag,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
-    character(len=*), intent(in)                  :: what
-    integer(psb_ipk_), intent(in)                 :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act, iwhat
-    character(len=20)  :: name='s_parmatch_aggr_cseti'
-    info = psb_success_
-
-    ! For now we ignore IDX
-
-    select case(psb_toupper(trim(what)))
-    case('PRMC_MATCH_ALG')
-      ag%matching_alg=val
-    case('PRMC_SWEEPS')
-      ag%n_sweeps=val
-    case('AGGR_SIZE')
-      ag%orig_aggr_size = val
-      ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
-    case('PRMC_W_SIZE')
-      call ag%bld_default_w(val)
-    case('PRMC_REPRODUCIBLE_MATCHING')
-      ag%reproducible_matching = (val == 1)
-    case('PRMC_NEED_SYMMETRIZE')
-      ag%need_symmetrize = (val == 1)
-    case('PRMC_UNSMOOTHED_HIERARCHY')
-      ag%unsmoothed_hierarchy = (val == 1)
-    case default
-      ! Do nothing
-    end select
-    return
-  end subroutine amg_s_parmatch_aggr_cseti
-
-  subroutine amg_s_parmatch_aggr_set_default(ag)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
-    character(len=20)  :: name='s_parmatch_aggr_set_default'
-    call ag%amg_s_base_aggregator_type%default()
-    ag%matching_alg  = 0
-    ag%n_sweeps      = 1
-    ag%jacobi_sweeps = 0
-!!$    ag%max_nlevels   = 36
-!!$    ag%max_csize     = -1
-    !
-    ! Apparently BootCMatch works better
-    ! by keeping all entries
-    !
-    ag%do_clean_zeros = .false.
-
-    return
-
-  end subroutine amg_s_parmatch_aggr_set_default
-
-  subroutine  amg_s_parmatch_aggregator_free(ag,info)
-    use iso_c_binding
-    implicit none
-    class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
-    integer(psb_ipk_), intent(out)       :: info
-
-    info = 0
-    if ((info == 0).and.allocated(ag%w)) deallocate(ag%w,stat=info)
-    if ((info == 0).and.allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info)
-    if ((info == 0).and.allocated(ag%prol)) then
-      call ag%prol%free(); deallocate(ag%prol,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%restr)) then
-      call ag%restr%free(); deallocate(ag%restr,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%ac)) then
-      call ag%ac%free(); deallocate(ag%ac,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%base_a)) then
-      call ag%base_a%free(); deallocate(ag%base_a,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%rwa)) then
-      call ag%rwa%free(); deallocate(ag%rwa,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%desc_ac)) then
-      call ag%desc_ac%free(info); deallocate(ag%desc_ac,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%desc_ax)) then
-      call ag%desc_ax%free(info); deallocate(ag%desc_ax,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%base_desc)) then
-      call ag%base_desc%free(info); deallocate(ag%base_desc,stat=info)
-    end if
-    if ((info == 0).and.allocated(ag%rwdesc)) then
-      call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
-    end if
-
-  end subroutine amg_s_parmatch_aggregator_free
-
-  subroutine  amg_s_parmatch_aggregator_clone(ag,agnext,info)
-    implicit none
-    class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
-    class(amg_s_base_aggregator_type), allocatable, intent(inout) :: agnext
-    integer(psb_ipk_), intent(out)       :: info
-
-    info = 0
-    if (allocated(agnext)) then
-      call agnext%free(info)
-      if (info == 0) deallocate(agnext,stat=info)
-    end if
-    if (info /= 0) return
-    allocate(agnext,source=ag,stat=info)
-    select type(agnext)
-    class is (amg_s_parmatch_aggregator_type)
-      call agnext%set_c_default_w()
-    class default
-      ! Should never ever get here
-      info = -1
-    end select
-  end subroutine amg_s_parmatch_aggregator_clone
-
-  subroutine  amg_s_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
-       & op_restr,op_prol,map,info)
-    use psb_base_mod
-    implicit none
-    class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
-    type(psb_desc_type), intent(in), target :: desc_a, desc_ac
-    integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-    type(psb_sspmat_type), intent(inout)   :: op_prol, op_restr
-    type(psb_slinmap_type), intent(out)     :: map
-    integer(psb_ipk_), intent(out)          :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20) :: name='s_parmatch_aggregator_bld_map'
-
-    call psb_erractionsave(err_act)
-    !
-    ! Copy the prolongation/restriction matrices into the descriptor map.
-    !  op_restr => PR^T   i.e. restriction  operator
-    !  op_prol => PR     i.e. prolongation operator
-    !
-    !  For parmatch have an explicit copy of the descriptors
-    !
-    if (allocated(ag%desc_ax)) then
-!!$      write(0,*) 'Building linmap with ag%desc_ax ',ag%desc_ax%get_local_rows(),ag%desc_ax%get_local_cols(),&
-!!$           & desc_ac%get_local_rows(),desc_ac%get_local_cols()
-      map = psb_linmap(psb_map_gen_linear_,ag%desc_ax,&
-           & desc_ac,op_restr,op_prol,ilaggr,nlaggr)
-    else
-      map = psb_linmap(psb_map_gen_linear_,desc_a,&
-           & desc_ac,op_restr,op_prol,ilaggr,nlaggr)
-    end if
-    if(info /= psb_success_) then
-      call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
-      goto 9999
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-
-    return
-  end subroutine amg_s_parmatch_aggregator_bld_map
-#endif
-end module amg_s_parmatch_aggregator_mod

amgprec/amg_s_poly_smoother.f90

@@ -1,374 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Daniela di Serafino
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-!
-! File: amg_s_poly_smoother_mod.f90
-!
-! Module: amg_s_poly_smoother_mod
-!
-!  This module defines:
-!    the amg_s_poly_smoother_type data structure containing the
-!    smoother for a Jacobi/block Jacobi smoother.
-!  The smoother stores in ND the block off-diagonal matrix.
-!  One special case is treated separately, when the solver is DIAG or L1-DIAG
-!  then the ND is the entire off-diagonal part of the matrix (including the
-!  main diagonal block), so that it becomes possible to implement
-!  a pure Jacobi or L1-Jacobi global solver.
-!
-module amg_s_poly_smoother
-  use amg_s_base_smoother_mod
-  use amg_d_poly_coeff_mod
-  
-  type, extends(amg_s_base_smoother_type) :: amg_s_poly_smoother_type
-    ! The local solver component is inherited from the
-    ! parent type.
-    !    class(amg_s_base_solver_type), allocatable :: sv
-    !
-    integer(psb_ipk_)              :: pdegree, variant
-    integer(psb_ipk_)              :: rho_estimate=amg_poly_rho_est_power_
-    integer(psb_ipk_)              :: rho_estimate_iterations=10
-    type(psb_sspmat_type), pointer :: pa => null()
-    real(psb_spk_), allocatable    :: poly_beta(:)
-    real(psb_spk_)                 :: cf_a = szero
-    real(psb_spk_)                 :: rho_ba = -sone
-  contains
-    procedure, pass(sm) :: apply_v => amg_s_poly_smoother_apply_vect
-!!$    procedure, pass(sm) :: apply_a => amg_s_poly_smoother_apply
-    procedure, pass(sm) :: dump    => amg_s_poly_smoother_dmp
-    procedure, pass(sm) :: build   => amg_s_poly_smoother_bld
-    procedure, pass(sm) :: cnv     => amg_s_poly_smoother_cnv
-    procedure, pass(sm) :: clone   => amg_s_poly_smoother_clone
-    procedure, pass(sm) :: clone_settings => amg_s_poly_smoother_clone_settings
-    procedure, pass(sm) :: clear_data     => amg_s_poly_smoother_clear_data  
-    procedure, pass(sm) :: free    => s_poly_smoother_free
-    procedure, pass(sm) :: cseti   => amg_s_poly_smoother_cseti
-    procedure, pass(sm) :: csetc   => amg_s_poly_smoother_csetc
-    procedure, pass(sm) :: csetr   => amg_s_poly_smoother_csetr
-    procedure, pass(sm) :: descr   => amg_s_poly_smoother_descr
-    procedure, pass(sm) :: sizeof  => s_poly_smoother_sizeof
-    procedure, pass(sm) :: default => s_poly_smoother_default
-    procedure, pass(sm) :: get_nzeros => s_poly_smoother_get_nzeros
-    procedure, pass(sm) :: get_wrksz => s_poly_smoother_get_wrksize
-    procedure, nopass   :: get_fmt    => s_poly_smoother_get_fmt
-    procedure, nopass   :: get_id     => s_poly_smoother_get_id
-  end type amg_s_poly_smoother_type
-  private :: s_poly_smoother_free, &
-       & s_poly_smoother_sizeof,  s_poly_smoother_get_nzeros, &
-       & s_poly_smoother_get_fmt, s_poly_smoother_get_id, &
-       & s_poly_smoother_get_wrksize
-
-
-  interface
-    subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
-         & sweeps,work,wv,info,init,initu)
-      import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
-           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
-           & psb_ipk_
-
-      type(psb_desc_type), intent(in)                 :: desc_data
-      class(amg_s_poly_smoother_type), intent(inout) :: sm
-      type(psb_s_vect_type),intent(inout)           :: x
-      type(psb_s_vect_type),intent(inout)           :: y
-      real(psb_spk_),intent(in)                      :: alpha,beta
-      character(len=1),intent(in)                     :: trans
-      integer(psb_ipk_), intent(in)                   :: sweeps
-      real(psb_spk_),target, intent(inout)           :: work(:)
-      type(psb_s_vect_type),intent(inout)           :: wv(:)
-      integer(psb_ipk_), intent(out)                  :: info
-      character, intent(in), optional                :: init
-      type(psb_s_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_s_poly_smoother_apply_vect
-  end interface
-
-!!$  interface
-!!$    subroutine amg_s_poly_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
-!!$         & sweeps,work,info,init,initu)
-!!$      import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
-!!$           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
-!!$           & psb_ipk_
-!!$      type(psb_desc_type), intent(in)      :: desc_data
-!!$      class(amg_s_poly_smoother_type), intent(inout) :: sm
-!!$      real(psb_spk_),intent(inout)         :: x(:)
-!!$      real(psb_spk_),intent(inout)         :: y(:)
-!!$      real(psb_spk_),intent(in)            :: alpha,beta
-!!$      character(len=1),intent(in)           :: trans
-!!$      integer(psb_ipk_), intent(in)         :: sweeps
-!!$      real(psb_spk_),target, intent(inout) :: work(:)
-!!$      integer(psb_ipk_), intent(out)        :: info
-!!$      character, intent(in), optional       :: init
-!!$      real(psb_spk_),intent(inout), optional :: initu(:)
-!!$    end subroutine amg_s_poly_smoother_apply
-!!$  end interface
-!!$
-  
-  interface
-    subroutine amg_s_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
-      import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
-           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      type(psb_sspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a
-      class(amg_s_poly_smoother_type), intent(inout)       :: sm
-      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
-    end subroutine amg_s_poly_smoother_bld
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_cnv(sm,info,amold,vmold,imold)
-      import :: amg_s_poly_smoother_type, psb_spk_, &
-           & psb_s_base_sparse_mat, psb_s_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      class(amg_s_poly_smoother_type), intent(inout)       :: sm
-      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
-    end subroutine amg_s_poly_smoother_cnv
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, &
-           & psb_ipk_
-      implicit none
-      class(amg_s_poly_smoother_type), intent(in) :: sm
-      type(psb_desc_type), intent(in)               :: desc
-      integer(psb_ipk_), intent(in)               :: level
-      integer(psb_ipk_), intent(out)              :: info
-      character(len=*), intent(in), optional :: prefix, head
-      logical, optional, intent(in)    :: smoother, solver, global_num
-    end subroutine amg_s_poly_smoother_dmp
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_clone(sm,smout,info)
-      import :: amg_s_poly_smoother_type, psb_spk_, &
-           & amg_s_base_smoother_type, psb_ipk_
-      class(amg_s_poly_smoother_type), intent(inout)               :: sm
-      class(amg_s_base_smoother_type), allocatable, intent(inout) :: smout
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_s_poly_smoother_clone
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_clone_settings(sm,smout,info)
-      import :: amg_s_poly_smoother_type, psb_spk_, &
-           & amg_s_base_smoother_type, psb_ipk_
-      class(amg_s_poly_smoother_type), intent(inout)               :: sm
-      class(amg_s_base_smoother_type), allocatable, intent(inout) :: smout
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_s_poly_smoother_clone_settings
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_clear_data(sm,info)
-      import :: amg_s_poly_smoother_type, psb_spk_, &
-           & amg_s_base_smoother_type, psb_ipk_
-      class(amg_s_poly_smoother_type), intent(inout)               :: sm
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_s_poly_smoother_clear_data
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_descr(sm,info,iout,coarse,prefix)
-      import :: amg_s_poly_smoother_type, psb_ipk_
-      class(amg_s_poly_smoother_type), intent(in) :: sm
-      integer(psb_ipk_), intent(out)               :: info
-      integer(psb_ipk_), intent(in), optional      :: iout
-      logical, intent(in), optional                :: coarse
-      character(len=*), intent(in), optional       :: prefix
-    end subroutine amg_s_poly_smoother_descr
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_cseti(sm,what,val,info,idx)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_s_poly_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      integer(psb_ipk_), intent(in)                  :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_s_poly_smoother_cseti
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_csetc(sm,what,val,info,idx)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_s_poly_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      character(len=*), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_s_poly_smoother_csetc
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_csetr(sm,what,val,info,idx)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_s_poly_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      real(psb_spk_), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_s_poly_smoother_csetr
-  end interface
-
-
-contains
-
-
-  subroutine s_poly_smoother_free(sm,info)
-
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_poly_smoother_type), intent(inout) :: sm
-    integer(psb_ipk_), intent(out)                  :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20)  :: name='s_poly_smoother_free'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-
-
-    if (allocated(sm%sv)) then
-      call sm%sv%free(info)
-      if (info == psb_success_) deallocate(sm%sv,stat=info)
-      if (info /= psb_success_) then
-        info = psb_err_alloc_dealloc_
-        call psb_errpush(info,name)
-        goto 9999
-      end if
-    end if
-    if (allocated(sm%poly_beta))  deallocate(sm%poly_beta)
-    sm%pa => null()
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_poly_smoother_free
-
-  function s_poly_smoother_sizeof(sm) result(val)
-
-    implicit none
-    ! Arguments
-    class(amg_s_poly_smoother_type), intent(in) :: sm
-    integer(psb_epk_) :: val
-
-    val = psb_sizeof_dp
-    if (allocated(sm%sv)) val = val + sm%sv%sizeof()
-    if (allocated(sm%poly_beta)) val = val + psb_sizeof_dp * size(sm%poly_beta)
-
-    return
-  end function s_poly_smoother_sizeof
-
-  subroutine s_poly_smoother_default(sm)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_poly_smoother_type), intent(inout) :: sm
-
-    !
-    ! Default: BJAC with no residual check
-    !
-    sm%pdegree      = 1
-    sm%rho_ba       = -sone
-    sm%variant      = amg_poly_lottes_
-    sm%rho_estimate = amg_poly_rho_est_power_
-    sm%rho_estimate_iterations = 20
-    if (allocated(sm%sv)) then
-      call sm%sv%default()
-    end if
-
-    return
-  end subroutine s_poly_smoother_default
-
-  function s_poly_smoother_get_nzeros(sm) result(val)
-
-    implicit none
-    ! Arguments
-    class(amg_s_poly_smoother_type), intent(in) :: sm
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-
-    val = 0
-    if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()
-
-    return
-  end function s_poly_smoother_get_nzeros
-
-  function s_poly_smoother_get_wrksize(sm) result(val)
-    implicit none
-    class(amg_s_poly_smoother_type), intent(inout) :: sm
-    integer(psb_ipk_)  :: val
-
-    val = 4
-    if (allocated(sm%sv)) val = val + sm%sv%get_wrksz()
-
-  end function s_poly_smoother_get_wrksize
-
-  function s_poly_smoother_get_fmt() result(val)
-    implicit none
-    character(len=32)  :: val
-
-    val = "Polynomial smoother"
-  end function s_poly_smoother_get_fmt
-
-  function s_poly_smoother_get_id() result(val)
-    implicit none
-    integer(psb_ipk_)  :: val
-
-    val = amg_poly_
-  end function s_poly_smoother_get_id
-
-
-end module amg_s_poly_smoother

amgprec/amg_s_prec_mod.f90

@@ -2,9 +2,9 @@
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !
-!    (C) Copyright 2021
+!    (C) Copyright 2020
 !
 !        Salvatore Filippone
 !        Pasqua D'Ambra
@@ -40,7 +40,7 @@
 ! Module: amg_s_prec_mod
 !
 !  This module defines the user interfaces to the real/complex, single/double
-!  precision versions of the user-level AMG4PSBLAS routines.
+!  precision versions of the user-level MLD2P4 routines.
 !
 module amg_s_prec_mod
 
@@ -55,7 +55,12 @@ module amg_s_prec_mod
   use amg_s_ainv_solver
   use amg_s_invk_solver
   use amg_s_invt_solver
-  use amg_s_krm_solver
+
+  interface amg_precset
+    module procedure amg_s_iprecsetsm, amg_s_iprecsetsv, &
+         & amg_s_cprecseti, amg_s_cprecsetc, amg_s_cprecsetr, &
+         & amg_s_iprecsetag
+  end interface amg_precset
 
   interface amg_extprol_bld
     subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
@@ -77,4 +82,61 @@ module amg_s_prec_mod
     end subroutine amg_s_extprol_bld
   end interface amg_extprol_bld
 
+contains
+
+  subroutine amg_s_iprecsetsm(p,val,info,pos)
+    type(amg_sprec_type), intent(inout)    :: p
+    class(amg_s_base_smoother_type), intent(in)   :: val
+    integer(psb_ipk_), intent(out)           :: info
+    character(len=*), optional, intent(in)      :: pos
+
+    call p%set(val,info,pos=pos)
+  end subroutine amg_s_iprecsetsm
+
+  subroutine amg_s_iprecsetsv(p,val,info,pos)
+    type(amg_sprec_type), intent(inout)    :: p
+    class(amg_s_base_solver_type), intent(in)   :: val
+    integer(psb_ipk_), intent(out)                :: info
+    character(len=*), optional, intent(in)      :: pos
+    call p%set(val,info, pos=pos)
+  end subroutine amg_s_iprecsetsv
+
+  subroutine amg_s_iprecsetag(p,val,info,pos)
+    type(amg_sprec_type), intent(inout)    :: p
+    class(amg_s_base_aggregator_type), intent(in)   :: val
+    integer(psb_ipk_), intent(out)                :: info
+    character(len=*), optional, intent(in)      :: pos
+    call p%set(val,info, pos=pos)
+  end subroutine amg_s_iprecsetag
+
+  subroutine amg_s_cprecseti(p,what,val,info,pos)
+    type(amg_sprec_type), intent(inout)   :: p
+    character(len=*), intent(in)            :: what
+    integer(psb_ipk_), intent(in)           :: val
+    integer(psb_ipk_), intent(out)          :: info
+    character(len=*), optional, intent(in)      :: pos
+
+    call p%set(what,val,info,pos=pos)
+  end subroutine amg_s_cprecseti
+
+  subroutine amg_s_cprecsetr(p,what,val,info,pos)
+    type(amg_sprec_type), intent(inout)   :: p
+    character(len=*), intent(in)            :: what
+    real(psb_spk_), intent(in)             :: val
+    integer(psb_ipk_), intent(out)          :: info
+    character(len=*), optional, intent(in)      :: pos
+
+    call p%set(what,val,info,pos=pos)
+  end subroutine amg_s_cprecsetr
+
+  subroutine amg_s_cprecsetc(p,what,val,info,pos)
+    type(amg_sprec_type), intent(inout)   :: p
+    character(len=*), intent(in)            :: what
+    character(len=*), intent(in)            :: val
+    integer(psb_ipk_), intent(out)          :: info
+    character(len=*), optional, intent(in)      :: pos
+
+    call p%set(what,val,info,pos=pos)
+  end subroutine amg_s_cprecsetc
+
 end module amg_s_prec_mod

amgprec/amg_s_prec_type.f90

@@ -2,9 +2,9 @@
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !
-!    (C) Copyright 2021
+!    (C) Copyright 2020
 !
 !        Salvatore Filippone
 !        Pasqua D'Ambra
@@ -66,7 +66,7 @@ module amg_s_prec_type
   !
   !  This is the data type containing all the information about the multilevel
   !  preconditioner ('d', 's', 'c' and 'z', according to the real/complex,
-  !  single/double precision version of  AMG4PSBLAS).
+  !  single/double precision version of  MLD2P4).
   !  It consists of an array of 'one-level' intermediate data structures
   !  of type amg_sonelev_type, each containing the information needed to apply
   !  the smoothing and the coarse-space correction at a generic level. RT is the
@@ -135,11 +135,8 @@ module amg_s_prec_type
     procedure, pass(prec)               :: build        => amg_sprecbld
     procedure, pass(prec)               :: hierarchy_build   => amg_s_hierarchy_bld
     procedure, pass(prec)               :: hierarchy_rebuild => amg_s_hierarchy_rebld
-    procedure, pass(prec)               :: hierarchy_free    => amg_s_hierarchy_free    
     procedure, pass(prec)               :: smoothers_build   => amg_s_smoothers_bld
-    procedure, pass(prec)               :: smoothers_free    => amg_s_smoothers_free
     procedure, pass(prec)               :: descr        =>  amg_sfile_prec_descr
-    procedure, pass(prec)               :: memory_use   =>  amg_sfile_prec_memory_use
   end type amg_sprec_type
 
   private :: amg_s_dump, amg_s_get_compl,  amg_s_cmp_compl,&
@@ -158,35 +155,16 @@ module amg_s_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity,prefix)
+    subroutine amg_sfile_prec_descr(prec,iout,root)
       import :: amg_sprec_type, psb_ipk_
       implicit none
       ! Arguments
-      class(amg_sprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out)          :: info
+      class(amg_sprec_type), intent(in)      :: prec
       integer(psb_ipk_), intent(in), optional :: iout
       integer(psb_ipk_), intent(in), optional :: root
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
     end subroutine amg_sfile_prec_descr
   end interface
 
-  
-  interface amg_memory_use
-    subroutine amg_sfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
-      import :: amg_sprec_type, psb_ipk_
-      implicit none
-      ! Arguments
-      class(amg_sprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: root
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_sfile_prec_memory_use
-  end interface
-
   interface amg_sizeof
     module procedure amg_sprec_sizeof
   end interface
@@ -364,14 +342,6 @@ module amg_s_prec_type
     end subroutine amg_s_smoothers_bld
   end interface amg_smoothers_bld
 
-  interface amg_smoothers_free
-    module procedure  amg_s_smoothers_free
-  end interface amg_smoothers_free
-
-  interface amg_hierarchy_free
-    module procedure amg_s_hierarchy_free
-  end interface amg_hierarchy_free
-
 contains
   !
   ! Function returning a pointer to the smoother
@@ -454,22 +424,11 @@ contains
     end if
   end function amg_s_get_nzeros
 
-  function amg_sprec_sizeof(prec, global) result(val)
+  function amg_sprec_sizeof(prec) result(val)
     implicit none
     class(amg_sprec_type), intent(in) :: prec
-    logical, intent(in), optional :: global
-    integer(psb_epk_) :: val    
+    integer(psb_epk_) :: val
     integer(psb_ipk_)        :: i
-    type(psb_ctxt_type) :: ctxt
-    
-    logical :: global_
-
-    if (present(global)) then
-      global_ = global
-    else
-      global_ = .false.
-    end if
-    
     val = 0
     val = val + psb_sizeof_ip
     if (allocated(prec%precv)) then
@@ -477,11 +436,6 @@ contains
         val = val + prec%precv(i)%sizeof()
       end do
     end if
-    if (global_) then
-      ctxt = prec%ctxt
-      call psb_sum(ctxt,val)
-    end if
-
   end function amg_sprec_sizeof
 
   !
@@ -645,68 +599,6 @@ contains
 
   end subroutine amg_s_prec_free
 
-  subroutine amg_s_smoothers_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_sprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_s_smoothers_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
-        call prec%precv(i)%free_smoothers(info)
-      end do
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_s_smoothers_free
-
-  subroutine amg_s_hierarchy_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_sprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_s_hierarchy_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    me=-1
-    write(0,*) 'Missing implementation '
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_s_hierarchy_free
 
 
   !
@@ -846,15 +738,16 @@ contains
     character(len=*), intent(in), optional  :: prefix, head
     logical, optional, intent(in)    :: smoother, solver,ac, rp, tprol, global_num
     integer(psb_ipk_)   :: i, j, il1, iln, lev
-    type(psb_ctxt_type) :: ctxt
+    type(psb_ctxt_type) :: icontxt
     integer(psb_ipk_)   :: iam, np, iproc_
     character(len=80)   :: prefix_
     character(len=120)  :: fname ! len should be at least 20 more than
     !  len of prefix_
 
     info = 0
-    ctxt = prec%ctxt
-    call psb_info(ctxt,iam,np)
+    icontxt = prec%ctxt
+    call psb_info(icontxt,iam,np)
+
     iln = size(prec%precv)
     if (present(istart)) then
       il1 = max(1,istart)
@@ -919,13 +812,13 @@ contains
     integer(psb_ipk_), intent(out)             :: info
     ! Local vars
     integer(psb_ipk_)   :: i, j, ln, lev
-    type(psb_ctxt_type) :: ctxt
+    type(psb_ctxt_type) :: icontxt
     integer(psb_ipk_)   :: iam, np
 
     info = psb_success_
     select type(pout => precout)
     class is (amg_sprec_type)
-      pout%ctxt          = prec%ctxt
+      pout%ctxt         = prec%ctxt
       pout%ag_data       = prec%ag_data
       pout%outer_sweeps  = prec%outer_sweeps
       if (allocated(prec%precv)) then
@@ -941,8 +834,8 @@ contains
           if (info == psb_success_) then
             pout%precv(lev)%base_a       => pout%precv(lev)%ac
             pout%precv(lev)%base_desc    => pout%precv(lev)%desc_ac
-            pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
-            pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
+            pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
+            pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
           end if
         end do
       end if
@@ -982,8 +875,8 @@ contains
       do i=2, size(b%precv)
         b%precv(i)%base_a    => b%precv(i)%ac
         b%precv(i)%base_desc => b%precv(i)%desc_ac
-        b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
-        b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
+        b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
+        b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
       end do
 
     else

amgprec/amg_s_rkr_solver.f90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!
+!    (C) Copyright 2020
+!
 !        Salvatore Filippone
 !        Pasqua D'Ambra
 !        Fabio Durastante
@@ -55,14 +52,14 @@
 !      2. Redistributions in binary form must reproduce the above copyright
 !         notice, this list of conditions, and the following disclaimer in the
 !         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!      3. The name of the MLD2P4 group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
 !
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
 !    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 !    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 !    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
@@ -73,16 +70,16 @@
 !
 !
 !
-! File: amg_s_krm_solver_mod.f90
+! File: amg_s_rkr_solver_mod.f90
 !
-! Module: amg_s_krm_solver_mod
+! Module: amg_s_rkr_solver_mod
 !
-module amg_s_krm_solver
+module amg_s_rkr_solver
 
   use amg_s_base_solver_mod
   use amg_s_prec_type
 
-  type, extends(amg_s_base_solver_type) :: amg_s_krm_solver_type
+  type, extends(amg_s_base_solver_type) :: amg_s_rkr_solver_type
     !
     logical               :: global
     character(len=16)     :: method, kprec, sub_solve
@@ -97,46 +94,46 @@ module amg_s_krm_solver
   contains
     !
     !
-    procedure, pass(sv) :: dump    => s_krm_solver_dmp
-    procedure, pass(sv) :: check   => s_krm_solver_check
-    procedure, pass(sv) :: clone   => s_krm_solver_clone
-    procedure, pass(sv) :: clone_settings   => s_krm_solver_clone_settings
-    procedure, pass(sv) :: cnv     => s_krm_solver_cnv
-    procedure, pass(sv) :: apply_v => amg_s_krm_solver_apply_vect
-    procedure, pass(sv) :: apply_a => amg_s_krm_solver_apply
-    procedure, pass(sv) :: clear_data  => s_krm_solver_clear_data
-    procedure, pass(sv) :: free    => s_krm_solver_free
-    procedure, pass(sv) :: cseti   => s_krm_solver_cseti
-    procedure, pass(sv) :: csetc   => s_krm_solver_csetc
-    procedure, pass(sv) :: csetr   => s_krm_solver_csetr
-    procedure, pass(sv) :: sizeof  => s_krm_solver_sizeof
-    procedure, pass(sv) :: get_nzeros => s_krm_solver_get_nzeros
-    !procedure, nopass   :: get_id  => s_krm_solver_get_id
-    procedure, pass(sv) :: is_global => s_krm_solver_is_global
-    procedure, nopass   :: is_iterative => s_krm_solver_is_iterative
+    procedure, pass(sv) :: dump    => s_rkr_solver_dmp
+    procedure, pass(sv) :: check   => s_rkr_solver_check
+    procedure, pass(sv) :: clone   => s_rkr_solver_clone
+    procedure, pass(sv) :: clone_settings   => s_rkr_solver_clone_settings
+    procedure, pass(sv) :: cnv     => s_rkr_solver_cnv
+    procedure, pass(sv) :: apply_v => amg_s_rkr_solver_apply_vect
+    procedure, pass(sv) :: apply_a => amg_s_rkr_solver_apply
+    procedure, pass(sv) :: clear_data  => s_rkr_solver_clear_data
+    procedure, pass(sv) :: free    => s_rkr_solver_free
+    procedure, pass(sv) :: cseti   => s_rkr_solver_cseti
+    procedure, pass(sv) :: csetc   => s_rkr_solver_csetc
+    procedure, pass(sv) :: csetr   => s_rkr_solver_csetr
+    procedure, pass(sv) :: sizeof  => s_rkr_solver_sizeof
+    procedure, pass(sv) :: get_nzeros => s_rkr_solver_get_nzeros
+    !procedure, nopass   :: get_id  => s_rkr_solver_get_id
+    procedure, pass(sv) :: is_global => s_rkr_solver_is_global
+    procedure, nopass   :: is_iterative => s_rkr_solver_is_iterative
 
 
     !
     ! These methods are specific for the new solver type
     ! and therefore need to be overridden
     !
-    procedure, pass(sv) :: descr   => s_krm_solver_descr
-    procedure, pass(sv) :: default => s_krm_solver_default
-    procedure, pass(sv) :: build   => amg_s_krm_solver_bld
-    procedure, nopass   :: get_fmt => s_krm_solver_get_fmt
-  end type amg_s_krm_solver_type
+    procedure, pass(sv) :: descr   => s_rkr_solver_descr
+    procedure, pass(sv) :: default => s_rkr_solver_default
+    procedure, pass(sv) :: build   => amg_s_rkr_solver_bld
+    procedure, nopass   :: get_fmt => s_rkr_solver_get_fmt
+  end type amg_s_rkr_solver_type
 
 
-  private ::  s_krm_solver_get_fmt, s_krm_solver_descr, s_krm_solver_default
+  private ::  s_rkr_solver_get_fmt, s_rkr_solver_descr, s_rkr_solver_default
 
   interface
-    subroutine amg_s_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
+    subroutine amg_s_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
          & trans,work,wv,info,init,initu)
-      import :: psb_desc_type, amg_s_krm_solver_type, psb_s_vect_type, psb_spk_, &
+      import :: psb_desc_type, amg_s_rkr_solver_type, psb_s_vect_type, psb_spk_, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
       implicit none
       type(psb_desc_type), intent(in)             :: desc_data
-      class(amg_s_krm_solver_type), intent(inout) :: sv
+      class(amg_s_rkr_solver_type), intent(inout) :: sv
       type(psb_s_vect_type),intent(inout)         :: x
       type(psb_s_vect_type),intent(inout)         :: y
       real(psb_spk_),intent(in)                    :: alpha,beta
@@ -146,17 +143,17 @@ module amg_s_krm_solver
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init
       type(psb_s_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_s_krm_solver_apply_vect
+    end subroutine amg_s_rkr_solver_apply_vect
   end interface
 
   interface
-    subroutine amg_s_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
+    subroutine amg_s_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
          & trans,work,info,init,initu)
-      import :: psb_desc_type, amg_s_krm_solver_type, psb_s_vect_type, psb_spk_, &
+      import :: psb_desc_type, amg_s_rkr_solver_type, psb_s_vect_type, psb_spk_, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
       implicit none
       type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_s_krm_solver_type), intent(inout) :: sv
+      class(amg_s_rkr_solver_type), intent(inout) :: sv
       real(psb_spk_),intent(inout)         :: x(:)
       real(psb_spk_),intent(inout)         :: y(:)
       real(psb_spk_),intent(in)            :: alpha,beta
@@ -165,24 +162,24 @@ module amg_s_krm_solver
       integer(psb_ipk_), intent(out)        :: info
       character, intent(in), optional       :: init
       real(psb_spk_),intent(inout), optional :: initu(:)
-    end subroutine amg_s_krm_solver_apply
+    end subroutine amg_s_rkr_solver_apply
   end interface
 
   interface
-    subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_s_krm_solver_type, psb_s_vect_type, psb_spk_, &
+    subroutine amg_s_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
+      import :: psb_desc_type, amg_s_rkr_solver_type, psb_s_vect_type, psb_spk_, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none
       type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
-      class(amg_s_krm_solver_type), intent(inout)         :: sv
+      class(amg_s_rkr_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info
       type(psb_sspmat_type), intent(in), target, optional :: b
       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
-    end subroutine amg_s_krm_solver_bld
+    end subroutine amg_s_rkr_solver_bld
   end interface
 
 
@@ -190,12 +187,12 @@ contains
 
   !
   !
-  subroutine s_krm_solver_default(sv)
+  subroutine s_rkr_solver_default(sv)
 
     Implicit None
 
     ! Arguments
-    class(amg_s_krm_solver_type), intent(inout) :: sv
+    class(amg_s_rkr_solver_type), intent(inout) :: sv
 
     sv%method     = 'bicgstab'
     sv%kprec      = 'bjac'
@@ -210,42 +207,42 @@ contains
     sv%global = .false.
 
     return
-  end subroutine s_krm_solver_default
+  end subroutine s_rkr_solver_default
 
-  function s_krm_solver_get_nzeros(sv) result(val)
+  function s_rkr_solver_get_nzeros(sv) result(val)
 
     implicit none
     ! Arguments
-    class(amg_s_krm_solver_type), intent(in) :: sv
+    class(amg_s_rkr_solver_type), intent(in) :: sv
     integer(psb_epk_) :: val
 
     val = sv%prec%get_nzeros()
 
     return
-  end function s_krm_solver_get_nzeros
+  end function s_rkr_solver_get_nzeros
 
-  function s_krm_solver_sizeof(sv) result(val)
+  function s_rkr_solver_sizeof(sv) result(val)
 
     implicit none
     ! Arguments
-    class(amg_s_krm_solver_type), intent(in) :: sv
+    class(amg_s_rkr_solver_type), intent(in) :: sv
     integer(psb_epk_) :: val
 
     val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
 
     return
-  end function s_krm_solver_sizeof
+  end function s_rkr_solver_sizeof
 
 
-  subroutine s_krm_solver_check(sv,info)
+  subroutine s_rkr_solver_check(sv,info)
 
     Implicit None
 
     ! Arguments
-    class(amg_s_krm_solver_type), intent(inout) :: sv
+    class(amg_s_rkr_solver_type), intent(inout) :: sv
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_) :: err_act
-    character(len=20) :: name='s_krm_solver_check'
+    character(len=20) :: name='s_rkr_solver_check'
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -259,36 +256,36 @@ contains
 9999 call psb_error_handler(err_act)
     return
 
-  end subroutine s_krm_solver_check
+  end subroutine s_rkr_solver_check
 
-  subroutine s_krm_solver_cseti(sv,what,val,info,idx)
+  subroutine s_rkr_solver_cseti(sv,what,val,info,idx)
 
     Implicit None
 
     ! Arguments
-    class(amg_s_krm_solver_type), intent(inout) :: sv
+    class(amg_s_rkr_solver_type), intent(inout) :: sv
     character(len=*), intent(in)                  :: what
     integer(psb_ipk_), intent(in)                 :: val
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_), intent(in), optional       :: idx
     integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='s_krm_solver_cseti'
+    character(len=20)  :: name='s_rkr_solver_cseti'
 
     info = psb_success_
     call psb_erractionsave(err_act)
 
     select case(psb_toupper(trim(what)))
-    case('KRM_IRST')
+    case('RKR_IRST')
       sv%irst = val
-    case('KRM_ISTOPC')
+    case('RKR_ISTOPC')
       sv%istopc = val
-    case('KRM_ITMAX')
+    case('RKR_ITMAX')
       sv%itmax = val
-    case('KRM_ITRACE')
+    case('RKR_ITRACE')
       sv%itrace = val
-    case('KRM_SUB_SOLVE')
+    case('RKR_SUB_SOLVE')
       sv%i_sub_solve = val
-    case('KRM_FILLIN')
+    case('RKR_FILLIN')
       sv%fillin = val
     case default
       call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
@@ -299,33 +296,33 @@ contains
 
 9999 call psb_error_handler(err_act)
     return
-  end subroutine s_krm_solver_cseti
+  end subroutine s_rkr_solver_cseti
 
-  subroutine s_krm_solver_csetc(sv,what,val,info,idx)
+  subroutine s_rkr_solver_csetc(sv,what,val,info,idx)
 
     Implicit None
 
     ! Arguments
-    class(amg_s_krm_solver_type), intent(inout) :: sv
+    class(amg_s_rkr_solver_type), intent(inout) :: sv
     character(len=*), intent(in)                  :: what
     character(len=*), intent(in)                  :: val
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_), intent(in), optional       :: idx
     integer(psb_ipk_)  :: err_act, ival
-    character(len=20)  :: name='s_krm_solver_csetc'
+    character(len=20)  :: name='s_rkr_solver_csetc'
 
     info = psb_success_
     call psb_erractionsave(err_act)
 
 
     select case(psb_toupper(trim(what)))
-    case('KRM_METHOD')
+    case('RKR_METHOD')
       sv%method = psb_toupper(trim(val))
-    case('KRM_KPREC')
+    case('RKR_KPREC')
       sv%kprec = psb_toupper(trim(val))
-    case('KRM_SUB_SOLVE')
+    case('RKR_SUB_SOLVE')
       sv%sub_solve = psb_toupper(trim(val))
-    case('KRM_GLOBAL')
+    case('RKR_GLOBAL')
       select case(psb_toupper(trim(val)))
       case('LOCAL','FALSE')
         sv%global = .false.
@@ -348,26 +345,26 @@ contains
 
 9999 call psb_error_handler(err_act)
     return
-  end subroutine s_krm_solver_csetc
+  end subroutine s_rkr_solver_csetc
 
-  subroutine s_krm_solver_csetr(sv,what,val,info,idx)
+  subroutine s_rkr_solver_csetr(sv,what,val,info,idx)
 
     Implicit None
 
     ! Arguments
-    class(amg_s_krm_solver_type), intent(inout) :: sv
+    class(amg_s_rkr_solver_type), intent(inout) :: sv
     character(len=*), intent(in)                  :: what
     real(psb_spk_), intent(in)                  :: val
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_), intent(in), optional       :: idx
     integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='s_krm_solver_csetr'
+    character(len=20)  :: name='s_rkr_solver_csetr'
 
     call psb_erractionsave(err_act)
     info = psb_success_
 
     select case(psb_toupper(what))
-    case('KRM_EPS')
+    case('RKR_EPS')
       sv%eps = val
     case default
       call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
@@ -378,18 +375,18 @@ contains
 
 9999 call psb_error_handler(err_act)
     return
-  end subroutine s_krm_solver_csetr
+  end subroutine s_rkr_solver_csetr
 
-  subroutine s_krm_solver_clear_data(sv,info)
+  subroutine s_rkr_solver_clear_data(sv,info)
     use psb_base_mod, only : psb_exit
     Implicit None
 
     ! Arguments
-    class(amg_s_krm_solver_type), intent(inout) :: sv
+    class(amg_s_rkr_solver_type), intent(inout) :: sv
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_) :: err_act
     type(psb_ctxt_type)  :: l_ctxt
-    character(len=20)  :: name='s_krm_solver_free'
+    character(len=20)  :: name='s_rkr_solver_free'
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -406,19 +403,19 @@ contains
     nullify(sv%a)
     call psb_erractionrestore(err_act)
     return
-  end subroutine s_krm_solver_clear_data
+  end subroutine s_rkr_solver_clear_data
 
 
-  subroutine s_krm_solver_free(sv,info)
+  subroutine s_rkr_solver_free(sv,info)
     use psb_base_mod, only : psb_exit
     Implicit None
 
     ! Arguments
-    class(amg_s_krm_solver_type), intent(inout) :: sv
+    class(amg_s_rkr_solver_type), intent(inout) :: sv
     integer(psb_ipk_), intent(out)                :: info
     integer(psb_ipk_)  :: err_act
     type(psb_ctxt_type) :: l_ctxt
-    character(len=20)  :: name='s_krm_solver_free'
+    character(len=20)  :: name='s_rkr_solver_free'
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -427,31 +424,29 @@ contains
 
     call psb_erractionrestore(err_act)
     return
-  end subroutine s_krm_solver_free
+  end subroutine s_rkr_solver_free
 
-  function s_krm_solver_get_fmt() result(val)
+  function s_rkr_solver_get_fmt() result(val)
     implicit none
     character(len=32)  :: val
 
-    val = "KRM solver"
-  end function s_krm_solver_get_fmt
+    val = "RKR solver"
+  end function s_rkr_solver_get_fmt
 
-  subroutine s_krm_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine s_rkr_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
-    class(amg_s_krm_solver_type), intent(in) :: sv
+    class(amg_s_rkr_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional              :: coarse
-    character(len=*), intent(in), optional  :: prefix
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_s_krm_solver_descr'
+    character(len=20), parameter :: name='amg_s_rkr_solver_descr'
     integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -460,33 +455,34 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
     if (sv%global) then
-      write(iout_,*) trim(prefix_), '  Krylov solver (global)'
+      write(iout_,*) '  Recursive Krylov solver (global)'
     else
-      write(iout_,*) trim(prefix_), '  Krylov solver (local) '
+      write(iout_,*) '  Recursive Krylov solver (local) '
     end if
-    write(iout_,*) trim(prefix_), '    method: ',sv%method
-    write(iout_,*) trim(prefix_), '     kprec: ',sv%kprec
-    call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
-    write(iout_,*) trim(prefix_), '     itmax: ',sv%itmax
-    write(iout_,*) trim(prefix_), '       eps: ',sv%eps
+    write(iout_,*) '    method: ',sv%method
+    write(iout_,*) '     kprec: ',sv%kprec
+    if (sv%i_sub_solve > 0) then
+      write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
+    else
+      write(iout_,*) ' sub_solve: ',sv%sub_solve
+    end if
+    write(iout_,*) '     itmax: ',sv%itmax
+    write(iout_,*) '       eps: ',sv%eps
+    write(iout_,*) '    fillin: ',sv%fillin
+
 
     call psb_erractionrestore(err_act)
     return
 
 9999 call psb_error_handler(err_act)
     return
-  end subroutine s_krm_solver_descr
+  end subroutine s_rkr_solver_descr
 
-  subroutine s_krm_solver_cnv(sv,info,amold,vmold,imold)
+  subroutine s_rkr_solver_cnv(sv,info,amold,vmold,imold)
     implicit none
-    class(amg_s_krm_solver_type), intent(inout)         :: sv
+    class(amg_s_rkr_solver_type), intent(inout)         :: sv
     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
@@ -494,13 +490,13 @@ contains
 
     call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
 
-  end subroutine s_krm_solver_cnv
+  end subroutine s_rkr_solver_cnv
 
-  subroutine s_krm_solver_clone(sv,svout,info)
+  subroutine s_rkr_solver_clone(sv,svout,info)
     Implicit None
 
     ! Arguments
-    class(amg_s_krm_solver_type), intent(inout)               :: sv
+    class(amg_s_rkr_solver_type), intent(inout)               :: sv
     class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
     integer(psb_ipk_), intent(out)              :: info
 
@@ -509,7 +505,7 @@ contains
     call svout%free(info)
     allocate(svout,stat=info,mold=sv)
     select type(so=>svout)
-    class is(amg_s_krm_solver_type)
+    class is(amg_s_rkr_solver_type)
       so%method = sv%method
       so%kprec  = sv%kprec
       so%sub_solve = sv%sub_solve
@@ -528,21 +524,21 @@ contains
       info = psb_err_internal_error_
     end select
 
-  end subroutine s_krm_solver_clone
+  end subroutine s_rkr_solver_clone
 
 
-  subroutine s_krm_solver_clone_settings(sv,svout,info)
+  subroutine s_rkr_solver_clone_settings(sv,svout,info)
     Implicit None
 
     ! Arguments
-    class(amg_s_krm_solver_type), intent(inout)               :: sv
+    class(amg_s_rkr_solver_type), intent(inout)               :: sv
     class(amg_s_base_solver_type), intent(inout) :: svout
     integer(psb_ipk_), intent(out)              :: info
 
     info = psb_success_
 
     select type(so=>svout)
-    class is(amg_s_krm_solver_type)
+    class is(amg_s_rkr_solver_type)
       so%method = sv%method
       so%kprec  = sv%kprec
       so%sub_solve = sv%sub_solve
@@ -558,11 +554,11 @@ contains
       info = psb_err_internal_error_
     end select
 
-  end subroutine s_krm_solver_clone_settings
+  end subroutine s_rkr_solver_clone_settings
 
-  subroutine s_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
+  subroutine s_rkr_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
     implicit none
-    class(amg_s_krm_solver_type), intent(in) :: sv
+    class(amg_s_rkr_solver_type), intent(in) :: sv
     type(psb_desc_type), intent(in)             :: desc
     integer(psb_ipk_), intent(in)              :: level
     integer(psb_ipk_), intent(out)             :: info
@@ -572,23 +568,23 @@ contains
 
     call sv%prec%dump(info,prefix=prefix,head=head)
 
-  end subroutine s_krm_solver_dmp
+  end subroutine s_rkr_solver_dmp
   !
-  ! Notify whether KRM is used as a global solver
+  ! Notify whether RKR is used as a global solver
   !
-  function s_krm_solver_is_global(sv) result(val)
+  function s_rkr_solver_is_global(sv) result(val)
     implicit none
-    class(amg_s_krm_solver_type), intent(in) :: sv
+    class(amg_s_rkr_solver_type), intent(in) :: sv
     logical  :: val
 
     val = (sv%global)
-  end function s_krm_solver_is_global
+  end function s_rkr_solver_is_global
   !
-  function s_krm_solver_is_iterative() result(val)
+  function s_rkr_solver_is_iterative() result(val)
     implicit none
     logical  :: val
 
     val = .true.
-  end function s_krm_solver_is_iterative
+  end function s_rkr_solver_is_iterative
 
-end module amg_s_krm_solver
+end module amg_s_rkr_solver

amgprec/amg_s_slu_solver.F90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -385,22 +385,20 @@ contains
   
   end subroutine s_slu_solver_finalize
 
-  subroutine s_slu_solver_descr(sv,info,iout,coarse,prefix)
+  subroutine s_slu_solver_descr(sv,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_s_slu_solver_type), intent(in) :: sv
-    integer, intent(out)                       :: info
-    integer, intent(in), optional              :: iout
-    logical, intent(in), optional              :: coarse
-    character(len=*), intent(in), optional     :: prefix
+    integer, intent(out)                     :: info
+    integer, intent(in), optional            :: iout
+    logical, intent(in), optional       :: coarse
 
     ! Local variables
     integer      :: err_act
     character(len=20), parameter :: name='amg_s_slu_solver_descr'
     integer :: iout_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -409,13 +407,8 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
     
-    write(iout_,*) trim(prefix_), '  SuperLU Sparse Factorization Solver. '
+    write(iout_,*) '  SuperLU Sparse Factorization Solver. '
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_s_symdec_aggregator_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -88,25 +88,16 @@ contains
     val = "Symmetric Decoupled aggregation"
   end function amg_s_symdec_aggregator_fmt
   
-  subroutine  amg_s_symdec_aggregator_descr(ag,parms,iout,info,prefix)
+  subroutine  amg_s_symdec_aggregator_descr(ag,parms,iout,info)
     implicit none 
     class(amg_s_symdec_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
-    character(len=*), intent(in), optional  :: prefix
 
-    character(1024)    :: prefix_
-
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
-    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info,prefix=prefix)
+    write(iout,*) 'Decoupled Aggregator locally-symmetrized'
+    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info)
     
     return
   end subroutine amg_s_symdec_aggregator_descr

amgprec/amg_z_ainv_solver.F90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -58,13 +55,13 @@ module amg_z_ainv_solver
     procedure, pass(sv) :: check   => amg_z_ainv_solver_check
     procedure, pass(sv) :: build   => amg_z_ainv_solver_bld
     procedure, pass(sv) :: clone   => amg_z_ainv_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_z_ainv_solver_clone_settings
     procedure, pass(sv) :: cseti   => amg_z_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_z_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_z_ainv_solver_csetr
-!!$    procedure, pass(sv) :: seti    => amg_z_ainv_solver_seti
-!!$    procedure, pass(sv) :: setc    => amg_z_ainv_solver_setc
-!!$    procedure, pass(sv) :: setr    => amg_z_ainv_solver_setr
+    procedure, pass(sv) :: seti    => amg_z_ainv_solver_seti
+    procedure, pass(sv) :: setc    => amg_z_ainv_solver_setc
+    procedure, pass(sv) :: setr    => amg_z_ainv_solver_setr
+    generic, public :: set => seti, setr, setc
     procedure, pass(sv) :: descr   => amg_z_ainv_solver_descr
     procedure, pass(sv) :: default => z_ainv_solver_default
     procedure, nopass   :: stringval  => z_ainv_stringval
@@ -86,16 +83,6 @@ module amg_z_ainv_solver
     end subroutine amg_z_ainv_solver_clone
   end interface
 
-  interface
-    subroutine amg_z_ainv_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
-       & amg_z_base_solver_type, psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
-      Implicit None
-      class(amg_z_ainv_solver_type), intent(inout)              :: sv
-      class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_z_ainv_solver_clone_settings
-  end interface
 
   interface
     subroutine amg_z_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
@@ -172,44 +159,44 @@ module amg_z_ainv_solver
     end subroutine amg_z_ainv_solver_csetr
   end interface
 
-!!$  interface
-!!$    subroutine amg_z_ainv_solver_setc(sv,what,val,info)
-!!$      import :: amg_z_ainv_solver_type, psb_ipk_
-!!$      Implicit none
-!!$      ! Arguments
-!!$      class(amg_z_ainv_solver_type), intent(inout) :: sv
-!!$      integer(psb_ipk_), intent(in)                :: what
-!!$      character(len=*), intent(in)                 :: val
-!!$      integer(psb_ipk_), intent(out)               :: info
-!!$    end subroutine amg_z_ainv_solver_setc
-!!$  end interface
-!!$
-!!$  interface
-!!$    subroutine amg_z_ainv_solver_seti(sv,what,val,info)
-!!$      import :: amg_z_ainv_solver_type, psb_ipk_
-!!$      Implicit none
-!!$      ! Arguments
-!!$      class(amg_z_ainv_solver_type), intent(inout) :: sv
-!!$      integer(psb_ipk_), intent(in)                :: what
-!!$      integer(psb_ipk_), intent(in)                :: val
-!!$      integer(psb_ipk_), intent(out)               :: info
-!!$    end subroutine amg_z_ainv_solver_seti
-!!$  end interface
-!!$
-!!$  interface
-!!$    subroutine amg_z_ainv_solver_setr(sv,what,val,info)
-!!$      import :: amg_z_ainv_solver_type, psb_ipk_, psb_dpk_
-!!$      Implicit none
-!!$      ! Arguments
-!!$      class(amg_z_ainv_solver_type), intent(inout) :: sv
-!!$      integer(psb_ipk_), intent(in)                :: what
-!!$      real(psb_dpk_), intent(in)                   :: val
-!!$      integer(psb_ipk_), intent(out)               :: info
-!!$    end subroutine amg_z_ainv_solver_setr
-!!$  end interface
+  interface
+    subroutine amg_z_ainv_solver_setc(sv,what,val,info)
+      import :: amg_z_ainv_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_z_ainv_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      character(len=*), intent(in)                 :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_z_ainv_solver_setc
+  end interface
 
   interface
-    subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse,prefix)
+    subroutine amg_z_ainv_solver_seti(sv,what,val,info)
+      import :: amg_z_ainv_solver_type, psb_ipk_
+      Implicit none
+      ! Arguments
+      class(amg_z_ainv_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      integer(psb_ipk_), intent(in)                :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_z_ainv_solver_seti
+  end interface
+
+  interface
+    subroutine amg_z_ainv_solver_setr(sv,what,val,info)
+      import :: amg_z_ainv_solver_type, psb_ipk_, psb_dpk_
+      Implicit none
+      ! Arguments
+      class(amg_z_ainv_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(in)                :: what
+      real(psb_dpk_), intent(in)                   :: val
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_z_ainv_solver_setr
+  end interface
+
+  interface
+    subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse)
       import :: psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
 
       Implicit None
@@ -219,7 +206,7 @@ module amg_z_ainv_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-      character(len=*), intent(in), optional  :: prefix
+
     end subroutine amg_z_ainv_solver_descr
   end interface
 

amgprec/amg_z_as_smoother.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -396,23 +396,21 @@ contains
   end subroutine z_as_smoother_default
 
 
-  subroutine z_as_smoother_descr(sm,info,iout,coarse,prefix)
+  subroutine z_as_smoother_descr(sm,info,iout,coarse)
 
     Implicit None
 
     ! Arguments
     class(amg_z_as_smoother_type), intent(in) :: sm
-    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional              :: coarse
-      character(len=*), intent(in), optional   :: prefix
+    integer(psb_ipk_), intent(out)                      :: info
+    integer(psb_ipk_), intent(in), optional             :: iout
+    logical, intent(in), optional             :: coarse
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_z_as_smoother_descr'
     integer(psb_ipk_) :: iout_
     logical      :: coarse_
-    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -426,21 +424,16 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
     if (.not.coarse_) then 
-      write(iout_,*) trim(prefix_), '  Additive Schwarz with  ',&
+      write(iout_,*) '  Additive Schwarz with  ',&
            &  sm%novr, ' overlap layers.'
-      write(iout_,*) trim(prefix_), '  Restrictor:  ',restrict_names(sm%restr)
-      write(iout_,*) trim(prefix_), '  Prolongator: ',prolong_names(sm%prol)
-      write(iout_,*) trim(prefix_), '  Local solver:'
+      write(iout_,*) '  Restrictor:  ',restrict_names(sm%restr)
+      write(iout_,*) '  Prolongator: ',prolong_names(sm%prol)
+      write(iout_,*) '  Local solver:'
     endif
     if (allocated(sm%sv)) then 
-      call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
+      call sm%sv%descr(info,iout_,coarse=coarse)
     end if
 
     call psb_erractionrestore(err_act)

amgprec/amg_z_base_aggregator_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021 
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -126,7 +126,7 @@ module amg_z_base_aggregator_mod
            & psb_z_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_z_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(inout)         :: desc_a
+      type(psb_desc_type), intent(in)            :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_dml_parms), intent(inout)         :: parms 
       type(psb_z_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -144,7 +144,7 @@ module amg_z_base_aggregator_mod
            & psb_z_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_z_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(inout)         :: desc_a
+      type(psb_desc_type), intent(in)            :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_dml_parms), intent(inout)         :: parms 
       type(psb_z_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -275,22 +275,15 @@ contains
     val = .false.
   end function amg_z_base_aggregator_xt_desc
 
-  subroutine  amg_z_base_aggregator_descr(ag,parms,iout,info,prefix)
+  subroutine  amg_z_base_aggregator_descr(ag,parms,iout,info)
     implicit none 
     class(amg_z_base_aggregator_type), intent(in) :: ag
     type(amg_dml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
-    character(len=*), intent(in), optional  :: prefix
-    character(1024)    :: prefix_
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
 
-    write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info,prefix=prefix)
+    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info)
     
     return
   end subroutine amg_z_base_aggregator_descr

amgprec/amg_z_base_ainv_mod.f90

@@ -1,14 +1,11 @@
-!  
-!   
+!
+!
+!                       AMG-AINV: Approximate Inverse plugin for
 !                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante 
+!
+!    (C) Copyright 2020
+!
+!                        Salvatore Filippone  University of Rome Tor Vergata
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions

amgprec/amg_z_base_smoother_mod.f90

@@ -2,9 +2,9 @@
 !   
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
 !    
-!    (C) Copyright 2021
+!    (C) Copyright 2020 
 !  
 !        Salvatore Filippone  
 !        Pasqua D'Ambra   
@@ -272,7 +272,7 @@ module amg_z_base_smoother_mod
   end interface
   
   interface 
-    subroutine amg_z_base_smoother_descr(sm,info,iout,coarse,prefix)
+    subroutine amg_z_base_smoother_descr(sm,info,iout,coarse)
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
            & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
            & amg_z_base_smoother_type, psb_ipk_
@@ -281,7 +281,6 @@ module amg_z_base_smoother_mod
       integer(psb_ipk_), intent(out)                :: info
       integer(psb_ipk_), intent(in), optional       :: iout
       logical, intent(in), optional                 :: coarse
-      character(len=*), intent(in), optional        :: prefix
     end subroutine amg_z_base_smoother_descr
   end interface