Fix CUDA defines for compilation

This reverts commit a17f503486.

.gitignore

@@ -12,11 +12,13 @@ config.log
 config.status
 
 # generated folder
-include/
-modules/
-docs/src/tmp
+/include/
+/modules/
+/docs/src/tmp
 autom4te.cache
 
 # the executable from tests
 runs
 
+# Documentation temporary files
+docs/src/userguide.pdf

Changelog

@@ -1,164 +0,0 @@
-Changelog. A lot less detailed than usual, at least for past
-	history.
-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. 	
-2018/05/14: Interface for extension of aggregation methods. 	
-2018/02/28: New cartesian distribution for sample programs.	
-2017/12/15: New WRK component of preconditioner levels, preallocation.	
-2017/10/25: New example input file formats. Added sample matrices.	
-2017/10/02: New CBIND in PSBLAS 3.5.0	
-2017/07/30: Refactored examples. Change default thresholds. 
-2017/05/31: New internal description of ML. 
-2017/05/16: Improve build process. 
-2017/04/20: Force %set interface. Update docs.	
-2017/04/03: Remove obsolete stuff. 	
-2017/03/17: Fixed level%cnv;  add coarse _solver tracker.	
-2017/02/18: Take out clean_zeros; changed NOFILTER; defined FBGS; take out
-	n_prec_levs.
-2017/02/12: Updated mat_dist usage, dubious SP shell for UMFPACK, fixes
-	for RPM packaging.      
-2017/02/02: Fix superlu configury	
-2016/11/12: Fix hierarchy/smoothers build to handle 1 level.	
-2016/10/03: Merged changes to hierearchy building.	
-2016/08/20: Reimplemented decoupled aggregation	
-2016/07/20: Refactored application of multilevel. Defined V,W and
-	K-cycles. 	
-2016/05/18: Reworked internals of PRECSET. Defined  Forward-Backward
-	Gauss-Seidel solver. Now available separate PRE and POST smoother
-	objects. 
-2016/03/30: MUMPS interface.	
-2016/02/28: Hybrid Gauss-Seidel method. 	
-2016/02/03: unify integer argument checks.	
-2015/12/15: defaults single vs. double precision. Use clean_zeros.	
-2015/12/08: new matdist interface	
-2015/10/17: configry fixes	
-2015/10/13: Fixes for SLUDIST versions 3 and 4
-2015/05/03: New heap interface	
-2015/04/21: INTENT fixes
-	
-2014/12/21: New error handling
-	
-2014/10/27: Added versioncheck to configure.
-	
-2014/03/31: New get_diag. 
-	 
-2013/11/07: Merged changes from experimental branch. Fix INCDIR in
-	    makefiles. 
-       
-2013/07/15: Fixes for UMFPACK 5.4, SuperLU 4.3, SuperLU_Dist 3.3
-	
-2013/04/05: CLONE method.	
-	
-2013/03/08: Reworked SET routines. 	
-	
-2012/12/10: Enable long_integers.
-	
-2012/12/05: Split smoother/solver objects.	
-	
-2012/04/30: New scheme to find dynamically the number of level based on
-	    the size of the coarse matrix
-	
-2012/01/10: Done split interface/implementation, plus subdir restructure.
-	
-2011/12/13: Start split interface/implementation to improve build time. 	
-	
-2011/11/25: Now works with _vect methods from PSBLAS. 	
-	
-2011/10/24: New test generation methods.
-	
-2011/06/15: Dump prolongator/restrictor
-	
-2011/04/14: Added MOLD argument(s) to precbld.       
-	
-2011/03/30: Fixed: descriptive methods, example programs.
-	
-2011/03/08: Re-factored modules for ILU methods.	
-	
-2011/03/04: Make X intent(inout) in APPLY to allow for preconditioners
-            using SPMM. 	
-	
-2011/03/02: New set methods.
-	
-2011/01/07: Fixed UMF interfacing for Z data.
-
-2011/01/04: Added UMF inteface for D data.
-	
-2011/01/02: Fix usage of DESC_DATA. Switched all names to F90 ending. 
-
-2010/12/16: Fix usage of replicated space descriptor.
-
-2010/11/16: Fix Jacobi smoother in case of empty off-diagonal. 	
-
-2010/11/04: Defined and tested single real and complex.
-
-2010/11/02: Aligned usage of sparse data type with psblas3.
-
-2009/12/22: Aligned constants with mld2p4 v1.2
-
-2009/12/11: First working version of double multilevel.
-
-2009/12/05: Inttroduction of Smoother/Solver object hierarchy.
-
-2009/09/23: Initial F2003 version. 	
-      
-	
-2009/01/28: Changed names from XbaseprcY to XbaseprecY.
-2009/01/27: Changed names from mld_transfer to mld_move_alloc.
-	
-2009/01/13: Repackaged the one-level preconditioners. Reorganized the
-            build routines, taking out mlprec_bld, and switching the
-	    number of levels when needed. 
-2008/10/27: Changed the definition of prec_type: repackaged with a
-	    onelev-prec-type, containing a baseprec and maps between
-	    index spaces. No performance impact; no changes to
-	    user-level interfaces.
-	
-2008/09/18: Changed mld_sizeof to integer(8); updated samples.	
-	
-2008/08/26: Fixed matrix generation in sample programs. 
-	
-2008/07/25: missing implicit none in mld_prec_type.	
-	
-2008/07/23: added HTML documentation  
-	
-2008/06/13: Fixed aggregation for replicated index spaces.
-
-2008/06/02: Threshold into decoupled aggregation algorithm.
-	
-2008/05/27: Single precision version.
-
-2008/03/09: Introduced configure script. 
-	
-2008/02/08: Merged changes from intermesh branch: we now have an
-	    inter_desc_type object. Cleaned up data allocation and
-	    variable initialization in multilevel prec application.
-
-2008/01/10: Merged various fixes for: prologues, unused variables,
-	    interface details.	
-2007/12/21: Merge version with prologues and internal docs.
-	
-2007/11/15: Created pargen example.	
-
-2007/11/14: Fix INTENT(IN) on X vector in preconditioner routines.
-
-2007/10/19: Merged in ILU(P,T). To be tested extensively.
-
-2007/10/17: Merged ILU(K) into trunk.
-
-2007/10/16: Fixed ILU(K), it now performs satisfactorily. Also updated
-	    ILU(0) to be more legible. 
-	
-2007/10/11: First working version of ILU(K). Still slow, there should
-	    be room for improvement. 
-	
-2007/10/09: Added benchmark code.
-
-2007/10/09: Added MILU_N_. Beware: values for UMF_ etc. have been
-	    shifted. 
-
-2007/10/02: To do: decide whether to name MLD_KRYLOV_MOD or
-	    PSB_KRYLOV_MOD. 
-
-2007/10/01: Start of this changelog. MLD2P4 now has a different
-	    structure, to enable a build not embedded in PSBLAS.

LICENSE

@@ -1,10 +1,10 @@
   
    
-                             AMG4PSBLAS version 1.0
+                             AMG4PSBLAS version 1.2
     Algebraic Multigrid Package
-               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+               based on PSBLAS (Parallel Sparse BLAS version 3.9)
     
-    (C) Copyright 2021
+    (C) Copyright 2025
   
         Salvatore Filippone  
         Pasqua D'Ambra   

Make.inc.in

@@ -75,7 +75,7 @@ CDEFINES=$(AMGCDEFINES)
 AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
 FDEFINES=$(AMGFDEFINES)
 
-CXXDEFINES=@AMGCXXDEFINES@
+CXXDEFINES=@AMGCXXDEFINES@ $(PSBCXXDEFINES)
 
 @COMPILERULES@
 

Make_n.inc.in

@@ -49,7 +49,7 @@ PSBLAS_INCLUDES=@PSBLAS_INCLUDES@
 PSBLAS_LIBS=@PSBLAS_LIBS@	
 PSBBASEMODNAME=psb_base_mod
 PSBPRECMODNAME=psb_prec_mod
-PSBMETHDMODNAME=psb_krylov_mod
+PSBMETHDMODNAME=psb_linsolve_mod
 PSBUTILMODNAME=psb_util_mod
 
 

Makefile

@@ -1,10 +1,13 @@
 include Make.inc
 
 
-all:  library 
+all:  objs lib
 
-library: libdir amgp cbnd
-#cbnd
+objs: libdir amgp cbnd
+
+lib:  objs
+	cd amgprec && $(MAKE) lib
+	cd cbind && $(MAKE)  lib
 
 libdir:
 	(if test ! -d lib ; then mkdir lib; fi)
@@ -14,10 +17,11 @@ libdir:
         
 
 amgp:
-	$(MAKE) -C amgprec all
+	cd amgprec && $(MAKE) objs
 cbnd: amgp
-	$(MAKE) -C cbind all
-install: all
+	cd cbind && $(MAKE)  objs
+
+install: lib
 	mkdir -p $(INSTALL_LIBDIR) &&\
 	   $(INSTALL_DATA) lib/*.a  $(INSTALL_LIBDIR)
 	mkdir -p  $(INSTALL_INCLUDEDIR) &&\
@@ -40,15 +44,18 @@ cleanlib:
 	(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)
+distclean: clean samplesclean
+	/bin/rm -fr Make.inc
+
+samplesclean: clean
+	(cd samples/simple/fileread && $(MAKE) clean)
+	(cd samples/simple/pdegen && $(MAKE) clean)
+	(cd samples/advanced/fileread && $(MAKE) clean)
+	(cd samples/advanced/pdegen && $(MAKE) clean)
 
 check: all
 	make check -C samples/advanced/pdegen
 
-clean:
-	(cd amgprec; make clean)
+clean:  cleanlib
+	(cd amgprec && $(MAKE) clean)
+	(cd cbind && $(MAKE) clean)

README.md

@@ -1,55 +1,76 @@
+# AMG4PSBLAS  v1.2
+Algebraic Multigrid Package  based on [PSBLAS](https://github.com/sfilippone/psblas3) (Parallel Sparse BLAS version 3.9)
 
-                         AMG4PSBLAS  
- 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)
-Fabio Durastante       (IAC-CNR, Naples, IT)
+AMG4PSBLAS is a package of parallel algebraic multilevel preconditioners included in the PSCToolkit (Parallel Sparse Computation Toolkit) software framework.
 
----------------------------------------------------------------------
+It is a progress of a software development project started in 2007, named MLD2P4, which originally implemented a multilevel version of some domain decomposition preconditioners of additive-Schwarz type and was based on a parallel decoupled version of the well known smoothed aggregation method to generate the multilevel hierarchy of coarser matrices.
 
-AMG4PSBLAS is a package of Algebraic MultiGrid (AMG)
-preconditioners for  the iterative solution of large and sparse linear systems.
+In the last years the package was extended for including new algorithms and functionalities for the setup and application new AMG preconditioners with the final aims of improving efficiency and scalability when tens of thousands cores are used and of boosting reliability in dealing with general symmetric positive definite linear systems.
 
-It is an evolution of MLD2P4 (see LICENSE.MLD2P4), but it has been
-thoroughly reworked, and it is sufficiently different to warrant a new
-project name.
+It is an evolution of MLD2P4 (see [LICENSE.MLD2P4](LICENSE.MLD2P4)), but due to the significant number of changes and the increase in scope, we decided to rename the package as AMG4PSBLAS.
 
+AMG4PSBLAS has been designed to provide scalable and easy-to-use preconditioners in the context of the PSBLAS (Parallel Sparse Basic Linear Algebra Subprograms) computational framework and can be used in conjuction with the Krylov solvers available in this framework. Our package is based on a completely algebraic approach; therefore users level interfaces assume that the system matrix and preconditioners are represented as PSBLAS distributed sparse matrices.
 
-MAIN REFERENCES:
+AMG4PSBLAS enables the user to easily specify different features of an algebraic multilevel preconditioner, thus allowing to experiment with different preconditioners for the problem and parallel computers at hand.
 
-     
+The package employs object-oriented design techniques in Fortran 2008, with interfaces to additional third party libraries such as MUMPS, UMFPACK, SuperLU, and SuperLU_Dist, which can be exploited in building multilevel preconditioners. The parallel implementation is based on a Single Program Multiple Data (SPMD) paradigm; the inter-process communication is based on MPI and is managed mainly through PSBLAS.
 
-P. D'Ambra, D. di Serafino, S. Filippone,
-MLD2P4: a Package of Parallel Algebraic Multilevel Domain Decomposition
-Preconditioners in Fortran 95,
-ACM Transactions on Mathematical Software, 37 (3), 2010, art. 30,
-doi: 10.1145/1824801.1824808.
+## Main Refrerences:
 
+The main reference for this project is
+> D'Ambra, P., Durastante, F., & Filippone, S. (2021). AMG preconditioners for linear solvers towards extreme scale. SIAM Journal on Scientific Computing, 43(5), S679-S703.
 
-TO COMPILE
+AMG4PSBLAS is the suite of preconditioners for the Parallel Sparse Computation Toolkit ([PSCToolkit](https://psctoolkit.github.io/)) suite of libraries. See the paper:
+> D’Ambra, P., Durastante, F., & Filippone, S. (2023). Parallel Sparse Computation Toolkit. Software Impacts, 15, 100463.
+
+The main reference for features inherited from MLD2P4 is
+> P. D'Ambra, D. di Serafino, S. Filippone,
+> MLD2P4: a Package of Parallel Algebraic Multilevel Domain Decomposition
+> Preconditioners in Fortran 95,
+> ACM Transactions on Mathematical Software, 37 (3), 2010, art. 30,
+> doi: 10.1145/1824801.1824808.
+
+## Installing
+
+Installation requires having a working version of the [PSBLAS](https://github.com/sfilippone/psblas3) library installed.
+AMG4PSBLAS has several interfaces to third-party libraries that can be used in the construction and application phases of preconditioners. 
+In particular, it is possible to link AMG4PSBLAS with the libraries: MUMPS, SuperLU, SuperLU_Dist, UMFPACK. This is _not mandatory_ and the library can run 
+in isolation and without these features.
 
 0. Unpack the tar file in a directory of your choice (preferrably
    outside the main PSBLAS directory).
-1. run configure --with-psblas=<ABSOLUTE path of the PSBLAS install directory>
+1. run configure `--with-psblas=<ABSOLUTE path of the PSBLAS install directory>`
    adding the options for MUMPS, SuperLU, SuperLU_Dist, UMFPACK as desired.
-   See MLD2P4 User's and Reference Guide (Section 3) for details.
-2. Tweak Make.inc if you are not satisfied.
-3. make; 
+   See [AMG4PSBLAS User's and Reference Guide](docs/amg4psblas_1.0-guide.pdf) (Section 3) for details.
+2. Tweak `Make.inc` if you are not satisfied.
+3. run `make`; 
 4. Go into the test subdirectory and build the examples of your choice.
-5. (if desired): make install 
+5. (if desired): `make install` 
 
+>[!CAUTION]
+>The single precision version is supported only by MUMPS and SuperLU;
+>thus, even if you specify at configure time to use UMFPACK or SuperLU_Dist,
+>the corresponding preconditioner options will be available only from
+>the double precision version.
 
-NOTES
+### CUDA, OpeMP, OpenACC
 
-- The single precision version is supported only by MUMPS and SuperLU;
-  thus, even if you specify at configure time to use UMFPACK or SuperLU_Dist, 
-  the corresponding preconditioner options will be available only from
-  the double precision version.
+CUDA, OpenMP and OpenACC features are transparently inherited by PSBLAS installation. If PSBLAS has been configured (and installed) with these supports then AMG4PSBLAS will transparently inherit them. It will then be possible to move the computation to GPU accelerator simply by selecting the appropriate variable types. If these have not been activated or installed for PSBLAS then they will not be available for AMG4PSBLAS either and the operation will be purely on CPU/MPI. See also the samples/cuda folder.
 
+### EoCoE - Software as service portal
+
+In the European project “Energy oriented Center of Excellence: toward exascale for energy” we made available a software as service portal: [https://eocoe.psnc.pl/](https://eocoe.psnc.pl/). This permits to test several cutting-edge computational methods for accelerating the transition to the production, storage and management of clean, decarbonized energy. Among them you have the possibility of running PSBLAS+AMG4PSBLAS on some test problems to become familiar with using the software.
+
+## TODO and bugs
+ 
+- [X] Fix all reamining bugs. Bugs? We dont' have any ! 🤓
+
+> [!NOTE]
+> To report bugs 🐛 or issues ❓ please use the [GitHub issue system](https://github.com/sfilippone/amg4psblas/issues).
+
+## The AMG4PSBLAS team. 
+
+- Pasqua D'Ambra         (IAC-CNR, Naples, IT)
+- Fabio Durastante       (University of Pisa and IAC-CNR, IT)
+- Salvatore Filippone    (University of Rome Tor Vergata and IAC-CNR, IT)
 
-The AMG4PSBLAS team. 
----------------
-Salvatore Filippone
-Pasqua     D'Ambra
-Fabio     Durastante

ReleaseNews

@@ -1,5 +1,19 @@
 WHAT'S NEW
 
+AMG4PSBLAS
+Version 1.2
+   1. New polynomial smoothers.
+   2. Introduced L1-variants
+   3. Reorganization of sample programs.
+   
+Version 1.1
+   1. Reworked approximate inverse solvers.
+   
+
+Version 1.0
+   1. Transitioned from MLD2P4
+
+MLD2P4
 Version 2.1
    1. The multigrid preconditioner now include fully general V- and
       W-cycles. We also support K-cycles, both for symmetric and 

amgprec/Makefile

@@ -9,9 +9,10 @@ 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_gs_solver.o amg_d_mumps_solver.o amg_d_jac_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 \
@@ -20,9 +21,9 @@ DMODOBJS=amg_d_prec_type.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_slu_solver.o amg_s_id_solver.o\
+	amg_s_poly_smoother.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_gs_solver.o amg_s_mumps_solver.o  amg_s_jac_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 \
@@ -33,7 +34,7 @@ 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_gs_solver.o amg_z_mumps_solver.o  amg_z_jac_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 \
@@ -43,7 +44,7 @@ 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_gs_solver.o amg_c_mumps_solver.o  amg_c_jac_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 \
@@ -62,17 +63,20 @@ OBJS=$(MODOBJS)
 LOCAL_MODS=$(MODOBJS:.o=$(.mod))
 LIBNAME=libamg_prec.a
 
-all: lib impld
+all: objs impld
 
-impld: $(OBJS)
-	$(MAKE) -C impl
+objs: $(OBJS)
+	/bin/cp -p amg_const.h $(INCDIR)
+	/bin/cp -p *$(.mod) $(MODDIR)
+
+impld: objs
+	cd impl && $(MAKE) 
 
 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)
@@ -152,7 +156,7 @@ amg_z_base_ainv_mod.o: amg_z_base_solver_mod.o amg_base_ainv_mod.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_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_jac_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
@@ -161,9 +165,11 @@ 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_base_solver_mod.o  amg_s_prec_type.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_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
@@ -173,7 +179,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_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_jac_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
@@ -183,7 +189,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_base_solver_mod.o  amg_c_prec_type.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_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
@@ -218,4 +224,4 @@ clean: implclean
 	/bin/rm -f $(OBJS) $(LOCAL_MODS) *$(.mod)
 
 implclean:
-	$(MAKE) -C impl clean
+	cd impl && $(MAKE) clean

amgprec/amg_base_prec_type.F90

@@ -64,7 +64,7 @@ module amg_base_prec_type
   !
   use psb_const_mod
   use psb_base_mod, only :&
-       & psb_desc_type, psb_i_vect_type, psb_i_base_vect_type,&
+       & psb_desc_type, psb_ctxt_type,&
        & psb_ipk_, psb_dpk_, psb_spk_, psb_epk_,  &
        & psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, &
        & psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,&
@@ -81,9 +81,9 @@ module amg_base_prec_type
   !
   ! Version numbers
   !
-  character(len=*), parameter   :: amg_version_string_ = "1.1.0"
+  character(len=*), parameter   :: amg_version_string_ = "1.2.0"
   integer(psb_ipk_), parameter  :: amg_version_major_  = 1
-  integer(psb_ipk_), parameter  :: amg_version_minor_  = 1
+  integer(psb_ipk_), parameter  :: amg_version_minor_  = 2
   integer(psb_ipk_), parameter  :: amg_patchlevel_     = 0
 
   type amg_ml_parms
@@ -94,6 +94,7 @@ module amg_base_prec_type
     integer(psb_ipk_) :: aggr_omega_alg, aggr_eig, aggr_filter
     integer(psb_ipk_) :: coarse_mat, coarse_solve
   contains
+    procedure, pass(pm) :: get_coarse_mat  => ml_parms_get_coarse_mat
     procedure, pass(pm) :: get_coarse  => ml_parms_get_coarse
     procedure, pass(pm) :: clone       => ml_parms_clone
     procedure, pass(pm) :: descr       => ml_parms_descr
@@ -214,7 +215,8 @@ module amg_base_prec_type
   integer(psb_ipk_), parameter :: amg_fbgs_     = 6
   integer(psb_ipk_), parameter :: amg_l1_gs_    = 7
   integer(psb_ipk_), parameter :: amg_l1_fbgs_  = 8
-  integer(psb_ipk_), parameter :: amg_max_prec_ = 8
+  integer(psb_ipk_), parameter :: amg_poly_     = 9
+  integer(psb_ipk_), parameter :: amg_max_prec_ = 9
   !
   ! Constants for pre/post signaling. Now only used internally
   !
@@ -232,9 +234,9 @@ module amg_base_prec_type
   integer(psb_ipk_), parameter :: amg_diag_scale_    = amg_slv_delta_+1
   integer(psb_ipk_), parameter :: amg_l1_diag_scale_ = amg_slv_delta_+2
   integer(psb_ipk_), parameter :: amg_gs_            = amg_slv_delta_+3
-  ! !$  integer(psb_ipk_), parameter :: amg_ilu_n_         = amg_slv_delta_+4
-  ! !$  integer(psb_ipk_), parameter :: amg_milu_n_        = amg_slv_delta_+5
-  ! !$  integer(psb_ipk_), parameter :: amg_ilu_t_         = amg_slv_delta_+6
+  integer(psb_ipk_), parameter :: amg_ilu_n_         = amg_slv_delta_+4
+  integer(psb_ipk_), parameter :: amg_milu_n_        = amg_slv_delta_+5
+  integer(psb_ipk_), parameter :: amg_ilu_t_         = amg_slv_delta_+6
   integer(psb_ipk_), parameter :: amg_slu_           = amg_slv_delta_+7
   integer(psb_ipk_), parameter :: amg_umf_           = amg_slv_delta_+8
   integer(psb_ipk_), parameter :: amg_sludist_       = amg_slv_delta_+9
@@ -286,17 +288,19 @@ module amg_base_prec_type
   !
   ! Legal values for entry: amg_aggr_prol_
   !
-  integer(psb_ipk_), parameter :: amg_no_smooth_   = 0
-  integer(psb_ipk_), parameter :: amg_smooth_prol_ = 1
-  integer(psb_ipk_), parameter :: amg_min_energy_  = 2
+  integer(psb_ipk_), parameter :: amg_no_smooth_      = 0
+  integer(psb_ipk_), parameter :: amg_smooth_prol_    = 1
+  integer(psb_ipk_), parameter :: amg_l1_smooth_prol_ = 2
+  integer(psb_ipk_), parameter :: amg_min_energy_     = 3
   ! Disabling min_energy  for the time being.
-  integer(psb_ipk_), parameter :: amg_max_aggr_prol_=amg_smooth_prol_
+  integer(psb_ipk_), parameter :: amg_max_aggr_prol_= amg_l1_smooth_prol_
   !
   ! Legal values for entry: amg_aggr_filter_
   !
-  integer(psb_ipk_), parameter :: amg_no_filter_mat_  = 0
-  integer(psb_ipk_), parameter :: amg_filter_mat_     = 1
-  integer(psb_ipk_), parameter :: amg_max_filter_mat_ = amg_filter_mat_
+  integer(psb_ipk_), parameter :: amg_no_filter_mat_   = 0
+  integer(psb_ipk_), parameter :: amg_filter_mat_      = 1
+  integer(psb_ipk_), parameter :: amg_filter_prow_mat_ = 2
+  integer(psb_ipk_), parameter :: amg_max_filter_mat_  = amg_filter_prow_mat_
   !
   ! Legal values for entry: amg_aggr_ord_
   !
@@ -318,6 +322,16 @@ module amg_base_prec_type
   integer(psb_ipk_), parameter :: amg_distr_mat_      = 0
   integer(psb_ipk_), parameter :: amg_repl_mat_       = 1
   integer(psb_ipk_), parameter :: amg_max_coarse_mat_ = amg_repl_mat_
+  !
+  ! Legal values for entry: amg_poly_variant_
+  !
+  integer(psb_ipk_), parameter :: amg_cheb_4_     = 0
+  integer(psb_ipk_), parameter :: amg_cheb_4_opt_ = 1
+  integer(psb_ipk_), parameter :: amg_cheb_1_opt_ = 2
+  integer(psb_ipk_), parameter :: amg_poly_dbg_   = 8
+  
+  integer(psb_ipk_), parameter :: amg_poly_rho_est_power_ = 0
+
   !
   ! Legal values for entry: amg_prec_status_
   !
@@ -364,10 +378,11 @@ module amg_base_prec_type
   character(len=19), parameter, private :: &
        &  eigen_estimates(0:0)=(/'infinity norm     '/)
   character(len=15), parameter, private :: &
-       &  aggr_prols(0:3)=(/'unsmoothed    ','smoothed      ',&
-       &           'min energy    ','bizr. smoothed'/)
+       &  aggr_prols(0:4)=(/'unsmoothed    ','smoothed      ',&
+       &  'l1-smoothed   ','min energy    ','bizr. smoothed'/)
   character(len=15), parameter, private :: &
-       &  aggr_filters(0:1)=(/'no filtering  ','filtering     '/)
+       &  aggr_filters(0:2)=(/'no filtering  ','filtering     ',&
+       &  'filtering rsum'/)
   character(len=15), parameter, private :: &
        &  matrix_names(0:1)=(/'distributed   ','replicated    '/)
   character(len=18), parameter, private :: &
@@ -389,12 +404,12 @@ module amg_base_prec_type
        &  ml_names(0:7)=(/'none          ','additive      ',&
        &  'multiplicative', 'VCycle        ','WCycle        ',&
        &  'KCycle        ','KCycleSym     ','new ML        '/)
-  character(len=15), parameter :: &
+  character(len=16), parameter :: &
        &  amg_fact_names(0:amg_max_sub_solve_)=(/&
        & 'none          ','Jacobi        ',&
        & 'L1-Jacobi     ','none          ','none          ',&
        & 'none          ','none          ','L1-GS         ',&
-       & 'L1-FBGS       ','none          ','Point Jacobi  ',&
+       & 'L1-FBGS       ','Polynomial    ','none          ','Point Jacobi  ',&
        & 'L1-Jacobi     ','Gauss-Seidel  ','ILU(n)        ',&
        & 'MILU(n)       ','ILU(t,n)      ',&
        & 'SuperLU       ','UMFPACK LU    ',&
@@ -456,12 +471,12 @@ contains
     character(len=*), parameter :: name='amg_stringval'
   ! Local variable
     integer :: index_tab
-    character(len=15) ::string2
+    character(len=128) ::string2
     index_tab=index(string,char(9))
     if (index_tab.NE.0)  then
-       string2=string(1:index_tab-1)
+      string2=string(1:index_tab-1)
     else
-       string2=string
+      string2=string
     endif
     select case(psb_toupper(trim(string2)))
     case('NONE')
@@ -481,11 +496,11 @@ contains
     case('BGS','BWGS')
       val = amg_bwgs_
     case('ILU')
-      val = psb_ilu_n_
+      val = amg_ilu_n_
     case('MILU')
-      val = psb_milu_n_
+      val = amg_milu_n_
     case('ILUT')
-      val = psb_ilu_t_
+      val = amg_ilu_t_
     case('MUMPS')
       val = amg_mumps_
     case('UMF')
@@ -536,6 +551,8 @@ contains
       val = amg_no_smooth_
     case('SMOOTHED')
       val = amg_smooth_prol_
+    case('L1-SMOOTHED','L1SMOOTHED')
+      val = amg_l1_smooth_prol_
     case('MINENERGY')
       val = amg_min_energy_
     case('NOPREC')
@@ -556,6 +573,18 @@ contains
       val = amg_krm_
     case('AS')
       val = amg_as_
+    case('POLY')
+      val = amg_poly_
+    case('CHEB_4')
+      val = amg_cheb_4_
+    case('CHEB_4_OPT')
+      val = amg_cheb_4_opt_
+    case('CHEB_1_OPT')
+      val = amg_cheb_1_opt_
+    case('POLY_DBG')
+      val = amg_poly_dbg_
+    case('POLY_RHO_EST_POWER')
+      val =  amg_poly_rho_est_power_
     case('A_NORMI')
       val = amg_max_norm_
     case('USER_CHOICE')
@@ -564,6 +593,8 @@ contains
       val = amg_eig_est_
     case('FILTER')
       val = amg_filter_mat_
+    case('FILTERROWSUM')
+      val = amg_filter_prow_mat_
     case('NOFILTER','NO_FILTER')
       val = amg_no_filter_mat_
     case('OUTER_SWEEPS')
@@ -577,6 +608,33 @@ contains
     end select
   end function amg_stringval
 
+  function amg_get_coarse_mat_name(val) result(res)
+    character(len=15) :: res
+    integer :: val
+    select case(val)
+    case (0,1)
+      res = matrix_names(val)
+    case default
+      res = 'Unknown '
+    end select
+  end function amg_get_coarse_mat_name
+
+  subroutine amg_warn_coarse_mat(val,expected)
+    integer(psb_ipk_) :: val, expected
+    if (val /= expected) then
+      write(0,*) 'Warning: resetting COARSE_MAT on an existing hierarchy from ',&
+           & amg_get_coarse_mat_name(val), ' to ',amg_get_coarse_mat_name(expected)
+    end if
+  end subroutine amg_warn_coarse_mat
+
+  
+  function  ml_parms_get_coarse_mat(pm) result(res)
+    implicit none
+    class(amg_ml_parms), intent(in)    :: pm
+    integer(psb_ipk_) :: res
+    res   = pm%coarse_mat
+  end function ml_parms_get_coarse_mat
+
   subroutine  ml_parms_get_coarse(pm,pmin)
     implicit none
     class(amg_ml_parms), intent(inout) :: pm
@@ -639,10 +697,10 @@ contains
            &   ml_names(pm%ml_cycle)
       select case (pm%ml_cycle)
       case (amg_add_ml_)
-        write(iout,*) '  Number of smoother sweeps : ',&
+        write(iout,*) '  Number of smoother sweeps/degree : ',&
              & pm%sweeps_pre
       case (amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_, amg_kcycle_ml_, amg_kcyclesym_ml_)
-        write(iout,*) '  Number of smoother sweeps : pre: ',&
+        write(iout,*) '  Number of smoother sweeps/degree : pre: ',&
              &  pm%sweeps_pre ,'  post: ', pm%sweeps_post
       end select
 
@@ -1008,8 +1066,8 @@ contains
     integer(psb_ipk_), intent(in) :: ip
     logical             :: is_legal_ilu_fact
 
-    is_legal_ilu_fact = ((ip==psb_ilu_n_).or.&
-         & (ip==psb_milu_n_).or.(ip==psb_ilu_t_))
+    is_legal_ilu_fact = ((ip==amg_ilu_n_).or.&
+         & (ip==amg_milu_n_).or.(ip==amg_ilu_t_))
     return
   end function is_legal_ilu_fact
   function is_legal_d_omega(ip)

amgprec/amg_c_ainv_solver.F90

@@ -58,12 +58,10 @@ 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) :: descr   => amg_c_ainv_solver_descr
     procedure, pass(sv) :: default => c_ainv_solver_default
     procedure, nopass   :: stringval  => c_ainv_stringval
@@ -85,6 +83,16 @@ 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), 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)

amgprec/amg_c_hybrid_aggregator_mod.F90

@@ -1,125 +0,0 @@
-!  
-!   
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (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:
-!      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 
-!
-!    S. Gratton, P. Henon, P. Jiranek and X. Vasseur:
-!    Reducing complexity of algebraic multigrid by aggregation
-!    Numerical Lin. Algebra with Applications, 2016, 23:501-518
-!    
-module amg_c_hybrid_aggregator_mod
-
-  use amg_c_dec_aggregator_mod
-  !
-  !   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 
-  !
-  !
-  type, extends(amg_c_dec_aggregator_type) :: amg_c_hybrid_aggregator_type
-    
-  contains
-    procedure, pass(ag) :: bld_tprol    => amg_c_hybrid_aggregator_build_tprol
-    procedure, nopass   :: fmt          => amg_c_hybrid_aggregator_fmt
-  end type amg_c_hybrid_aggregator_type
-
-
-  interface
-    subroutine  amg_c_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
-      import :: amg_c_hybrid_aggregator_type, psb_desc_type, psb_cspmat_type, psb_spk_,  &
-           & psb_ipk_, psb_long_int_k_, amg_sml_parms
-      implicit none
-      class(amg_c_hybrid_aggregator_type), target, intent(inout) :: ag
-      type(amg_sml_parms), intent(inout)  :: parms 
-      type(psb_cspmat_type), intent(in)   :: a
-      type(psb_desc_type), intent(in)     :: desc_a
-      integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
-      type(psb_cspmat_type), intent(out)  :: op_prol
-      integer(psb_ipk_), intent(out)      :: info
-    end subroutine amg_c_hybrid_aggregator_build_tprol
-  end interface
-
-contains
-
-
-  function amg_c_hybrid_aggregator_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "Hybrid Decoupled aggregation"
-  end function amg_c_hybrid_aggregator_fmt
-
-  
-end module amg_c_hybrid_aggregator_mod

amgprec/amg_c_ilu_solver.f90

@@ -234,7 +234,7 @@ contains
     ! Arguments
     class(amg_c_ilu_solver_type), intent(inout) :: sv
 
-    sv%fact_type = psb_ilu_n_
+    sv%fact_type = amg_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',psb_ilu_n_,is_legal_ilu_fact)
+         & 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
 
     select case(sv%fact_type)
-    case(psb_ilu_n_,psb_milu_n_)      
+    case(amg_ilu_n_,amg_milu_n_)      
       call amg_check_def(sv%fill_in,&
            & 'Level',izero,is_int_non_negative)
-    case(psb_ilu_t_)                 
+    case(amg_ilu_t_)                 
       call amg_check_def(sv%thresh,&
            & 'Eps',szero,is_legal_s_fact_thrs)
     end select
@@ -439,9 +439,9 @@ contains
     write(iout_,*) trim(prefix_), '  Incomplete factorization solver: ',&
          &  amg_fact_names(sv%fact_type)
     select case(sv%fact_type)
-    case(psb_ilu_n_,psb_milu_n_)      
+    case(amg_ilu_n_,amg_milu_n_)      
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-    case(psb_ilu_t_)         
+    case(amg_ilu_t_)         
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
       write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
     end select
@@ -496,7 +496,7 @@ contains
     implicit none 
     integer(psb_ipk_)  :: val
     
-    val = psb_ilu_n_
+    val = amg_ilu_n_
   end function c_ilu_solver_get_id
 
   function c_ilu_solver_get_wrksize() result(val)

amgprec/amg_c_inner_mod.f90

@@ -109,11 +109,12 @@ module amg_c_inner_mod
   end interface amg_map_to_tprol
 
   abstract interface
-    subroutine amg_caggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_caggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
          & ac,desc_ac,op_prol,op_restr,t_prol,info)
       import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_, psb_lcspmat_type
       import ::  amg_c_onelev_type, amg_sml_parms
       implicit none 
+      integer(psb_ipk_), intent(in)               :: dol1smoothing
       type(psb_cspmat_type), intent(in)         :: a
       type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)            :: ilaggr(:), nlaggr(:)

amgprec/amg_c_invk_solver.f90

@@ -52,6 +52,7 @@ 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) :: descr   => amg_c_invk_solver_descr
@@ -73,6 +74,17 @@ 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), 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, &

amgprec/amg_c_invt_solver.f90

@@ -52,6 +52,7 @@ 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
@@ -73,6 +74,17 @@ 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), 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, &

amgprec/amg_c_jac_smoother.f90

@@ -203,8 +203,8 @@ module amg_c_jac_smoother
     subroutine amg_c_jac_smoother_clone_settings(sm,smout,info)
       import :: amg_c_jac_smoother_type, psb_spk_, &
            & amg_c_base_smoother_type, psb_ipk_
-      class(amg_c_jac_smoother_type), intent(inout)               :: sm
-      class(amg_c_base_smoother_type), allocatable, intent(inout) :: smout
+      class(amg_c_jac_smoother_type), intent(inout)  :: sm
+      class(amg_c_base_smoother_type), intent(inout) :: smout
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_c_jac_smoother_clone_settings
   end interface

amgprec/amg_c_jac_solver.f90

@@ -0,0 +1,585 @@
+!  
+!   
+!                             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_krm_solver.f90

@@ -473,7 +473,7 @@ contains
     end if
     write(iout_,*) trim(prefix_), '    method: ',sv%method
     write(iout_,*) trim(prefix_), '     kprec: ',sv%kprec
-    call sv%prec%descr(iout_,info,prefix='KRM : '//prefix_)
+    call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
     write(iout_,*) trim(prefix_), '     itmax: ',sv%itmax
     write(iout_,*) trim(prefix_), '       eps: ',sv%eps
 

amgprec/amg_c_mumps_solver.F90

@@ -78,7 +78,8 @@ module amg_c_mumps_solver
     !
     ! Controls to be set before MUMPS instantiation:
     !
-    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: LOCAL   1==amg_global_solver_: GLOBAL
+    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: 'LOCAL_SOLVER
+    !                            1==amg_global_solver_: 'GLOBAL_SOLVER'
     ! IPAR(2) : MUMPS_PRINT_ERR  print verbosity (see MUMPS)
     ! IPAR(3) : MUMPS_SYM        0: non-symmetric   2: symmetric
     integer(psb_ipk_), dimension(3) :: ipar

amgprec/amg_c_onelev_mod.f90

@@ -187,8 +187,10 @@ 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
@@ -272,6 +274,23 @@ module amg_c_onelev_mod
     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
     subroutine amg_c_base_onelev_cnv(lv,info,amold,vmold,imold)
       import :: amg_c_onelev_type, psb_c_base_vect_type, psb_spk_, &
@@ -285,7 +304,7 @@ module amg_c_onelev_mod
     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, &
@@ -297,6 +316,18 @@ interface
     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
     subroutine amg_c_base_onelev_check(lv,info)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &

amgprec/amg_c_prec_type.f90

@@ -135,8 +135,11 @@ 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,&
@@ -168,6 +171,22 @@ module amg_c_prec_type
     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
@@ -345,6 +364,14 @@ 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
@@ -618,6 +645,68 @@ 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
 
 
   !

amgprec/amg_d_ainv_solver.F90

@@ -58,12 +58,10 @@ 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) :: descr   => amg_d_ainv_solver_descr
     procedure, pass(sv) :: default => d_ainv_solver_default
     procedure, nopass   :: stringval  => d_ainv_stringval
@@ -85,6 +83,16 @@ 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), 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)

amgprec/amg_d_hybrid_aggregator_mod.F90

@@ -1,125 +0,0 @@
-!  
-!   
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (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:
-!      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 
-!
-!    S. Gratton, P. Henon, P. Jiranek and X. Vasseur:
-!    Reducing complexity of algebraic multigrid by aggregation
-!    Numerical Lin. Algebra with Applications, 2016, 23:501-518
-!    
-module amg_d_hybrid_aggregator_mod
-
-  use amg_d_dec_aggregator_mod
-  !
-  !   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 
-  !
-  !
-  type, extends(amg_d_dec_aggregator_type) :: amg_d_hybrid_aggregator_type
-    
-  contains
-    procedure, pass(ag) :: bld_tprol    => amg_d_hybrid_aggregator_build_tprol
-    procedure, nopass   :: fmt          => amg_d_hybrid_aggregator_fmt
-  end type amg_d_hybrid_aggregator_type
-
-
-  interface
-    subroutine  amg_d_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
-      import :: amg_d_hybrid_aggregator_type, psb_desc_type, psb_dspmat_type, psb_dpk_,  &
-           & psb_ipk_, psb_long_int_k_, amg_dml_parms
-      implicit none
-      class(amg_d_hybrid_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
-      integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
-      type(psb_dspmat_type), intent(out)  :: op_prol
-      integer(psb_ipk_), intent(out)      :: info
-    end subroutine amg_d_hybrid_aggregator_build_tprol
-  end interface
-
-contains
-
-
-  function amg_d_hybrid_aggregator_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "Hybrid Decoupled aggregation"
-  end function amg_d_hybrid_aggregator_fmt
-
-  
-end module amg_d_hybrid_aggregator_mod

amgprec/amg_d_ilu_solver.f90

@@ -234,7 +234,7 @@ contains
     ! Arguments
     class(amg_d_ilu_solver_type), intent(inout) :: sv
 
-    sv%fact_type = psb_ilu_n_
+    sv%fact_type = amg_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',psb_ilu_n_,is_legal_ilu_fact)
+         & 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
 
     select case(sv%fact_type)
-    case(psb_ilu_n_,psb_milu_n_)      
+    case(amg_ilu_n_,amg_milu_n_)      
       call amg_check_def(sv%fill_in,&
            & 'Level',izero,is_int_non_negative)
-    case(psb_ilu_t_)                 
+    case(amg_ilu_t_)                 
       call amg_check_def(sv%thresh,&
            & 'Eps',dzero,is_legal_d_fact_thrs)
     end select
@@ -439,9 +439,9 @@ contains
     write(iout_,*) trim(prefix_), '  Incomplete factorization solver: ',&
          &  amg_fact_names(sv%fact_type)
     select case(sv%fact_type)
-    case(psb_ilu_n_,psb_milu_n_)      
+    case(amg_ilu_n_,amg_milu_n_)      
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-    case(psb_ilu_t_)         
+    case(amg_ilu_t_)         
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
       write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
     end select
@@ -496,7 +496,7 @@ contains
     implicit none 
     integer(psb_ipk_)  :: val
     
-    val = psb_ilu_n_
+    val = amg_ilu_n_
   end function d_ilu_solver_get_id
 
   function d_ilu_solver_get_wrksize() result(val)

amgprec/amg_d_inner_mod.f90

@@ -109,11 +109,12 @@ module amg_d_inner_mod
   end interface amg_map_to_tprol
 
   abstract interface
-    subroutine amg_daggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_daggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
          & ac,desc_ac,op_prol,op_restr,t_prol,info)
       import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_, psb_lpk_, psb_ldspmat_type
       import ::  amg_d_onelev_type, amg_dml_parms
       implicit none 
+      integer(psb_ipk_), intent(in)               :: dol1smoothing
       type(psb_dspmat_type), intent(in)         :: a
       type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)            :: ilaggr(:), nlaggr(:)

amgprec/amg_d_invk_solver.f90

@@ -52,6 +52,7 @@ 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) :: descr   => amg_d_invk_solver_descr
@@ -73,6 +74,17 @@ 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), 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, &

amgprec/amg_d_invt_solver.f90

@@ -52,6 +52,7 @@ 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
@@ -73,6 +74,17 @@ 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), 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, &

amgprec/amg_d_jac_smoother.f90

@@ -203,8 +203,8 @@ module amg_d_jac_smoother
     subroutine amg_d_jac_smoother_clone_settings(sm,smout,info)
       import :: amg_d_jac_smoother_type, psb_dpk_, &
            & amg_d_base_smoother_type, psb_ipk_
-      class(amg_d_jac_smoother_type), intent(inout)               :: sm
-      class(amg_d_base_smoother_type), allocatable, intent(inout) :: smout
+      class(amg_d_jac_smoother_type), intent(inout)  :: sm
+      class(amg_d_base_smoother_type), intent(inout) :: smout
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_d_jac_smoother_clone_settings
   end interface

amgprec/amg_d_jac_solver.f90

@@ -0,0 +1,585 @@
+!  
+!   
+!                             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_krm_solver.f90

@@ -473,7 +473,7 @@ contains
     end if
     write(iout_,*) trim(prefix_), '    method: ',sv%method
     write(iout_,*) trim(prefix_), '     kprec: ',sv%kprec
-    call sv%prec%descr(iout_,info,prefix='KRM : '//prefix_)
+    call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
     write(iout_,*) trim(prefix_), '     itmax: ',sv%itmax
     write(iout_,*) trim(prefix_), '       eps: ',sv%eps
 

amgprec/amg_d_matchboxp_mod.f90

@@ -143,9 +143,10 @@ contains
     type(psb_ld_coo_sparse_mat) :: tmpcoo
     logical  :: display_out_, print_out_, reproducible_
     logical, parameter  :: dump=.false., debug=.false., dump_mate=.false., &
-         & debug_ilaggr=.false., debug_sync=.false.
+         & debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
     integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
     logical, parameter :: do_timings=.true.
+    integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
 
     ictxt = desc_a%get_ctxt()
     call psb_info(ictxt,iam,np)
@@ -187,7 +188,7 @@ contains
     call desc_a%l2gip(ilv,info,owned=.false.)
 
     call psb_geall(ilaggr,desc_a,info)
-    ilaggr = -1
+    ilaggr = ilaggr_neginit
     call psb_geasb(ilaggr,desc_a,info)
     nr = a%get_nrows()
     nc = a%get_ncols()
@@ -213,7 +214,20 @@ contains
       call psb_barrier(ictxt)
       if (iam == 0) write(0,*)' out from buildmatching:', info
     end if
-
+    if (debug_mate) then
+      block
+        integer(psb_lpk_), allocatable :: ckmate(:)
+        allocate(ckmate(nr))
+        ckmate(1:nr) = mate(1:nr)
+        call psb_msort(ckmate(1:nr))
+        do i=1,nr-1
+          if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
+            write(0,*) iam,' Duplicate mate entry  at',i,' :',ckmate(i)
+          end if
+        end do
+      end block
+    end if
+     
     if (info == 0) then
       if (do_timings) call psb_tic(idx_phase2)
       if (debug_sync) then
@@ -259,7 +273,7 @@ contains
           cycle
         else
 
-          if (ilaggr(k) == -1) then
+          if (ilaggr(k) == ilaggr_neginit) then
 
             wk   = w(k)
             widx = w(idx)
@@ -267,7 +281,7 @@ contains
             nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
             if (nrmagg > epsilon(nrmagg)) then
               if (idx <= nr) then
-                if (ilaggr(idx) == -1) then
+                if (ilaggr(idx) == ilaggr_neginit) then
                   ! Now, if both vertices are local, the aggregate is local
                   ! (kinda obvious).
                   nlaggr(iam) = nlaggr(iam) + 1
@@ -275,6 +289,9 @@ contains
                   ilaggr(idx) = nlaggr(iam)
                   wtemp(k)    = w(k)/nrmagg
                   wtemp(idx)  = w(idx)/nrmagg
+                else
+                  write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
+                       &mate(idx),ilaggr(idx)
                 end if
                 nlpairs = nlpairs+1
               else if (idx <= nc) then
@@ -294,7 +311,7 @@ contains
                     ilaggr(k)   = nlaggr(iam)
                     nlpairs = nlpairs+1
                   else
-                    ilaggr(k) = -2
+                    ilaggr(k) = ilaggr_nonlocal
                   end if
                 else
                   ! Use a statistically unbiased tie-breaking rule,
@@ -309,7 +326,7 @@ contains
                     ilaggr(k)   = nlaggr(iam)
                     nlpairs = nlpairs+1
                   else
-                    ilaggr(k) = -2
+                    ilaggr(k) = ilaggr_nonlocal
                   end if
                 end if
               end if
@@ -325,6 +342,12 @@ contains
                 nlsingl     = nlsingl + 1
               end if
             end if
+            if (ilaggr(k) == ilaggr_neginit) then
+              write(0,*) iam,' Error: no update to ',k,mate(k),&
+                   & abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
+            end if
+          else
+            if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
           end if
         end if
       end do
@@ -332,7 +355,7 @@ contains
       if (do_timings) call psb_tic(idx_phase3)
 
       ! Ok, now compute offsets, gather halo and fix non-local
-      ! aggregates  (those where ilaggr == -2)
+      ! aggregates  (those where ilaggr == ilaggr_nonlocal)
       call psb_sum(ictxt,nlaggr)
       ntaggr  = sum(nlaggr(0:np-1))
       naggrm1 = sum(nlaggr(0:iam-1))
@@ -347,7 +370,7 @@ contains
       call psb_halo(wtemp,desc_a,info)
       ! Cleanup as yet unmarked entries
       do k=1,nr
-        if (ilaggr(k) == -2) then
+        if (ilaggr(k) == ilaggr_nonlocal) then
           idx = mate(k)
           if (idx > nr) then
             i   = ilaggr(idx)
@@ -359,9 +382,14 @@ contains
           else
             write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
           end if
-        end if
-        if (ilaggr(k) <0) then
-          write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
+        else if (ilaggr(k) <0) then
+          write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
+          write(0,*) iam,'         :             : ',nr,nc,mate(k)
+          if (mate(k) <= nr) then
+            write(0,*) iam,'         :             : ',ilaggr(mate(k)),mate(mate(k)),&
+                 & ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
+          end if
+          flush(0)
         end if
       end do
       if (debug_sync) then
@@ -414,7 +442,7 @@ contains
 
       end block
       if (iam == 0) then
-        write(0,*) 'Matching statistics: Unmatched nodes ',&
+        write(0,*) iam,'Matching statistics: Unmatched nodes ',&
              & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
       end if
 

amgprec/amg_d_mumps_solver.F90

@@ -78,7 +78,8 @@ module amg_d_mumps_solver
     !
     ! Controls to be set before MUMPS instantiation:
     !
-    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: LOCAL   1==amg_global_solver_: GLOBAL
+    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: 'LOCAL_SOLVER
+    !                            1==amg_global_solver_: 'GLOBAL_SOLVER'
     ! IPAR(2) : MUMPS_PRINT_ERR  print verbosity (see MUMPS)
     ! IPAR(3) : MUMPS_SYM        0: non-symmetric   2: symmetric
     integer(psb_ipk_), dimension(3) :: ipar

amgprec/amg_d_onelev_mod.f90

@@ -188,8 +188,10 @@ 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
@@ -273,6 +275,23 @@ module amg_d_onelev_mod
     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
     subroutine amg_d_base_onelev_cnv(lv,info,amold,vmold,imold)
       import :: amg_d_onelev_type, psb_d_base_vect_type, psb_dpk_, &
@@ -286,7 +305,7 @@ module amg_d_onelev_mod
     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, &
@@ -298,6 +317,18 @@ interface
     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
     subroutine amg_d_base_onelev_check(lv,info)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &

amgprec/amg_d_parmatch_aggregator_mod.F90

@@ -244,11 +244,12 @@ module amg_d_parmatch_aggregator_mod
   end interface
 
   interface
-    subroutine amg_d_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_d_parmatch_unsmth_bld(dol1smoothing,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
+      integer(psb_ipk_), intent(in) :: dol1smoothing
       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
@@ -262,11 +263,12 @@ module amg_d_parmatch_aggregator_mod
   end interface
 
   interface
-    subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_d_parmatch_smth_bld(dol1smoothing,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
+      integer(psb_ipk_), intent(in) :: dol1smoothing
       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

amgprec/amg_d_poly_coeff_mod.f90

@@ -0,0 +1,548 @@
+!
+!
+!                             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

@@ -0,0 +1,374 @@
+!
+!
+!                             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), 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_cheb_4_
+    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_type.f90

@@ -135,8 +135,11 @@ 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,&
@@ -168,6 +171,22 @@ module amg_d_prec_type
     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
@@ -345,6 +364,14 @@ 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
@@ -618,6 +645,68 @@ 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
 
 
   !

amgprec/amg_s_ainv_solver.F90

@@ -58,12 +58,10 @@ 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) :: descr   => amg_s_ainv_solver_descr
     procedure, pass(sv) :: default => s_ainv_solver_default
     procedure, nopass   :: stringval  => s_ainv_stringval
@@ -85,6 +83,16 @@ 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), 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)

amgprec/amg_s_hybrid_aggregator_mod.F90

@@ -1,125 +0,0 @@
-!  
-!   
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (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:
-!      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 
-!
-!    S. Gratton, P. Henon, P. Jiranek and X. Vasseur:
-!    Reducing complexity of algebraic multigrid by aggregation
-!    Numerical Lin. Algebra with Applications, 2016, 23:501-518
-!    
-module amg_s_hybrid_aggregator_mod
-
-  use amg_s_dec_aggregator_mod
-  !
-  !   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 
-  !
-  !
-  type, extends(amg_s_dec_aggregator_type) :: amg_s_hybrid_aggregator_type
-    
-  contains
-    procedure, pass(ag) :: bld_tprol    => amg_s_hybrid_aggregator_build_tprol
-    procedure, nopass   :: fmt          => amg_s_hybrid_aggregator_fmt
-  end type amg_s_hybrid_aggregator_type
-
-
-  interface
-    subroutine  amg_s_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
-      import :: amg_s_hybrid_aggregator_type, psb_desc_type, psb_sspmat_type, psb_spk_,  &
-           & psb_ipk_, psb_long_int_k_, amg_sml_parms
-      implicit none
-      class(amg_s_hybrid_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
-      integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
-      type(psb_sspmat_type), intent(out)  :: op_prol
-      integer(psb_ipk_), intent(out)      :: info
-    end subroutine amg_s_hybrid_aggregator_build_tprol
-  end interface
-
-contains
-
-
-  function amg_s_hybrid_aggregator_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "Hybrid Decoupled aggregation"
-  end function amg_s_hybrid_aggregator_fmt
-
-  
-end module amg_s_hybrid_aggregator_mod

amgprec/amg_s_ilu_solver.f90

@@ -234,7 +234,7 @@ contains
     ! Arguments
     class(amg_s_ilu_solver_type), intent(inout) :: sv
 
-    sv%fact_type = psb_ilu_n_
+    sv%fact_type = amg_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',psb_ilu_n_,is_legal_ilu_fact)
+         & 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
 
     select case(sv%fact_type)
-    case(psb_ilu_n_,psb_milu_n_)      
+    case(amg_ilu_n_,amg_milu_n_)      
       call amg_check_def(sv%fill_in,&
            & 'Level',izero,is_int_non_negative)
-    case(psb_ilu_t_)                 
+    case(amg_ilu_t_)                 
       call amg_check_def(sv%thresh,&
            & 'Eps',szero,is_legal_s_fact_thrs)
     end select
@@ -439,9 +439,9 @@ contains
     write(iout_,*) trim(prefix_), '  Incomplete factorization solver: ',&
          &  amg_fact_names(sv%fact_type)
     select case(sv%fact_type)
-    case(psb_ilu_n_,psb_milu_n_)      
+    case(amg_ilu_n_,amg_milu_n_)      
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-    case(psb_ilu_t_)         
+    case(amg_ilu_t_)         
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
       write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
     end select
@@ -496,7 +496,7 @@ contains
     implicit none 
     integer(psb_ipk_)  :: val
     
-    val = psb_ilu_n_
+    val = amg_ilu_n_
   end function s_ilu_solver_get_id
 
   function s_ilu_solver_get_wrksize() result(val)

amgprec/amg_s_inner_mod.f90

@@ -109,11 +109,12 @@ module amg_s_inner_mod
   end interface amg_map_to_tprol
 
   abstract interface
-    subroutine amg_saggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_saggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
          & ac,desc_ac,op_prol,op_restr,t_prol,info)
       import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_, psb_lsspmat_type
       import ::  amg_s_onelev_type, amg_sml_parms
       implicit none 
+      integer(psb_ipk_), intent(in)               :: dol1smoothing
       type(psb_sspmat_type), intent(in)         :: a
       type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)            :: ilaggr(:), nlaggr(:)

amgprec/amg_s_invk_solver.f90

@@ -52,6 +52,7 @@ 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) :: descr   => amg_s_invk_solver_descr
@@ -73,6 +74,17 @@ 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), 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, &

amgprec/amg_s_invt_solver.f90

@@ -52,6 +52,7 @@ 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
@@ -73,6 +74,17 @@ 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), 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, &

amgprec/amg_s_jac_smoother.f90

@@ -203,8 +203,8 @@ module amg_s_jac_smoother
     subroutine amg_s_jac_smoother_clone_settings(sm,smout,info)
       import :: amg_s_jac_smoother_type, psb_spk_, &
            & amg_s_base_smoother_type, psb_ipk_
-      class(amg_s_jac_smoother_type), intent(inout)               :: sm
-      class(amg_s_base_smoother_type), allocatable, intent(inout) :: smout
+      class(amg_s_jac_smoother_type), intent(inout)  :: sm
+      class(amg_s_base_smoother_type), intent(inout) :: smout
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_s_jac_smoother_clone_settings
   end interface

amgprec/amg_s_jac_solver.f90

@@ -0,0 +1,585 @@
+!  
+!   
+!                             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_krm_solver.f90

@@ -473,7 +473,7 @@ contains
     end if
     write(iout_,*) trim(prefix_), '    method: ',sv%method
     write(iout_,*) trim(prefix_), '     kprec: ',sv%kprec
-    call sv%prec%descr(iout_,info,prefix='KRM : '//prefix_)
+    call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
     write(iout_,*) trim(prefix_), '     itmax: ',sv%itmax
     write(iout_,*) trim(prefix_), '       eps: ',sv%eps
 

amgprec/amg_s_matchboxp_mod.f90

@@ -143,9 +143,10 @@ contains
     type(psb_ls_coo_sparse_mat) :: tmpcoo
     logical  :: display_out_, print_out_, reproducible_
     logical, parameter  :: dump=.false., debug=.false., dump_mate=.false., &
-         & debug_ilaggr=.false., debug_sync=.false.
+         & debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
     integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
     logical, parameter :: do_timings=.true.
+    integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
 
     ictxt = desc_a%get_ctxt()
     call psb_info(ictxt,iam,np)
@@ -187,7 +188,7 @@ contains
     call desc_a%l2gip(ilv,info,owned=.false.)
 
     call psb_geall(ilaggr,desc_a,info)
-    ilaggr = -1
+    ilaggr = ilaggr_neginit
     call psb_geasb(ilaggr,desc_a,info)
     nr = a%get_nrows()
     nc = a%get_ncols()
@@ -213,7 +214,20 @@ contains
       call psb_barrier(ictxt)
       if (iam == 0) write(0,*)' out from buildmatching:', info
     end if
-
+    if (debug_mate) then
+      block
+        integer(psb_lpk_), allocatable :: ckmate(:)
+        allocate(ckmate(nr))
+        ckmate(1:nr) = mate(1:nr)
+        call psb_msort(ckmate(1:nr))
+        do i=1,nr-1
+          if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
+            write(0,*) iam,' Duplicate mate entry  at',i,' :',ckmate(i)
+          end if
+        end do
+      end block
+    end if
+     
     if (info == 0) then
       if (do_timings) call psb_tic(idx_phase2)
       if (debug_sync) then
@@ -259,7 +273,7 @@ contains
           cycle
         else
 
-          if (ilaggr(k) == -1) then
+          if (ilaggr(k) == ilaggr_neginit) then
 
             wk   = w(k)
             widx = w(idx)
@@ -267,7 +281,7 @@ contains
             nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
             if (nrmagg > epsilon(nrmagg)) then
               if (idx <= nr) then
-                if (ilaggr(idx) == -1) then
+                if (ilaggr(idx) == ilaggr_neginit) then
                   ! Now, if both vertices are local, the aggregate is local
                   ! (kinda obvious).
                   nlaggr(iam) = nlaggr(iam) + 1
@@ -275,6 +289,9 @@ contains
                   ilaggr(idx) = nlaggr(iam)
                   wtemp(k)    = w(k)/nrmagg
                   wtemp(idx)  = w(idx)/nrmagg
+                else
+                  write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
+                       &mate(idx),ilaggr(idx)
                 end if
                 nlpairs = nlpairs+1
               else if (idx <= nc) then
@@ -294,7 +311,7 @@ contains
                     ilaggr(k)   = nlaggr(iam)
                     nlpairs = nlpairs+1
                   else
-                    ilaggr(k) = -2
+                    ilaggr(k) = ilaggr_nonlocal
                   end if
                 else
                   ! Use a statistically unbiased tie-breaking rule,
@@ -309,7 +326,7 @@ contains
                     ilaggr(k)   = nlaggr(iam)
                     nlpairs = nlpairs+1
                   else
-                    ilaggr(k) = -2
+                    ilaggr(k) = ilaggr_nonlocal
                   end if
                 end if
               end if
@@ -325,6 +342,12 @@ contains
                 nlsingl     = nlsingl + 1
               end if
             end if
+            if (ilaggr(k) == ilaggr_neginit) then
+              write(0,*) iam,' Error: no update to ',k,mate(k),&
+                   & abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
+            end if
+          else
+            if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
           end if
         end if
       end do
@@ -332,7 +355,7 @@ contains
       if (do_timings) call psb_tic(idx_phase3)
 
       ! Ok, now compute offsets, gather halo and fix non-local
-      ! aggregates  (those where ilaggr == -2)
+      ! aggregates  (those where ilaggr == ilaggr_nonlocal)
       call psb_sum(ictxt,nlaggr)
       ntaggr  = sum(nlaggr(0:np-1))
       naggrm1 = sum(nlaggr(0:iam-1))
@@ -347,7 +370,7 @@ contains
       call psb_halo(wtemp,desc_a,info)
       ! Cleanup as yet unmarked entries
       do k=1,nr
-        if (ilaggr(k) == -2) then
+        if (ilaggr(k) == ilaggr_nonlocal) then
           idx = mate(k)
           if (idx > nr) then
             i   = ilaggr(idx)
@@ -359,9 +382,14 @@ contains
           else
             write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
           end if
-        end if
-        if (ilaggr(k) <0) then
-          write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
+        else if (ilaggr(k) <0) then
+          write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
+          write(0,*) iam,'         :             : ',nr,nc,mate(k)
+          if (mate(k) <= nr) then
+            write(0,*) iam,'         :             : ',ilaggr(mate(k)),mate(mate(k)),&
+                 & ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
+          end if
+          flush(0)
         end if
       end do
       if (debug_sync) then
@@ -414,7 +442,7 @@ contains
 
       end block
       if (iam == 0) then
-        write(0,*) 'Matching statistics: Unmatched nodes ',&
+        write(0,*) iam,'Matching statistics: Unmatched nodes ',&
              & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
       end if
 

amgprec/amg_s_mumps_solver.F90

@@ -78,7 +78,8 @@ module amg_s_mumps_solver
     !
     ! Controls to be set before MUMPS instantiation:
     !
-    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: LOCAL   1==amg_global_solver_: GLOBAL
+    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: 'LOCAL_SOLVER
+    !                            1==amg_global_solver_: 'GLOBAL_SOLVER'
     ! IPAR(2) : MUMPS_PRINT_ERR  print verbosity (see MUMPS)
     ! IPAR(3) : MUMPS_SYM        0: non-symmetric   2: symmetric
     integer(psb_ipk_), dimension(3) :: ipar

amgprec/amg_s_onelev_mod.f90

@@ -188,8 +188,10 @@ 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
@@ -273,6 +275,23 @@ module amg_s_onelev_mod
     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
     subroutine amg_s_base_onelev_cnv(lv,info,amold,vmold,imold)
       import :: amg_s_onelev_type, psb_s_base_vect_type, psb_spk_, &
@@ -286,7 +305,7 @@ module amg_s_onelev_mod
     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, &
@@ -298,6 +317,18 @@ interface
     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
     subroutine amg_s_base_onelev_check(lv,info)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &

amgprec/amg_s_parmatch_aggregator_mod.F90

@@ -244,11 +244,12 @@ module amg_s_parmatch_aggregator_mod
   end interface
 
   interface
-    subroutine amg_s_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_s_parmatch_unsmth_bld(dol1smoothing,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
+      integer(psb_ipk_), intent(in) :: dol1smoothing
       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
@@ -262,11 +263,12 @@ module amg_s_parmatch_aggregator_mod
   end interface
 
   interface
-    subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_s_parmatch_smth_bld(dol1smoothing,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
+      integer(psb_ipk_), intent(in) :: dol1smoothing
       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

amgprec/amg_s_poly_smoother.f90

@@ -0,0 +1,374 @@
+!
+!
+!                             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), 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_cheb_4_
+    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_type.f90

@@ -135,8 +135,11 @@ 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,&
@@ -168,6 +171,22 @@ module amg_s_prec_type
     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
@@ -345,6 +364,14 @@ 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
@@ -618,6 +645,68 @@ 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
 
 
   !

amgprec/amg_z_ainv_solver.F90

@@ -58,12 +58,10 @@ 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) :: descr   => amg_z_ainv_solver_descr
     procedure, pass(sv) :: default => z_ainv_solver_default
     procedure, nopass   :: stringval  => z_ainv_stringval
@@ -85,6 +83,16 @@ 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), 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)

amgprec/amg_z_hybrid_aggregator_mod.F90

@@ -1,125 +0,0 @@
-!  
-!   
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (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:
-!      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 
-!
-!    S. Gratton, P. Henon, P. Jiranek and X. Vasseur:
-!    Reducing complexity of algebraic multigrid by aggregation
-!    Numerical Lin. Algebra with Applications, 2016, 23:501-518
-!    
-module amg_z_hybrid_aggregator_mod
-
-  use amg_z_dec_aggregator_mod
-  !
-  !   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 
-  !
-  !
-  type, extends(amg_z_dec_aggregator_type) :: amg_z_hybrid_aggregator_type
-    
-  contains
-    procedure, pass(ag) :: bld_tprol    => amg_z_hybrid_aggregator_build_tprol
-    procedure, nopass   :: fmt          => amg_z_hybrid_aggregator_fmt
-  end type amg_z_hybrid_aggregator_type
-
-
-  interface
-    subroutine  amg_z_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
-      import :: amg_z_hybrid_aggregator_type, psb_desc_type, psb_zspmat_type, psb_dpk_,  &
-           & psb_ipk_, psb_long_int_k_, amg_dml_parms
-      implicit none
-      class(amg_z_hybrid_aggregator_type), target, intent(inout) :: ag
-      type(amg_dml_parms), intent(inout)  :: parms 
-      type(psb_zspmat_type), intent(in)   :: a
-      type(psb_desc_type), intent(in)     :: desc_a
-      integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
-      type(psb_zspmat_type), intent(out)  :: op_prol
-      integer(psb_ipk_), intent(out)      :: info
-    end subroutine amg_z_hybrid_aggregator_build_tprol
-  end interface
-
-contains
-
-
-  function amg_z_hybrid_aggregator_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "Hybrid Decoupled aggregation"
-  end function amg_z_hybrid_aggregator_fmt
-
-  
-end module amg_z_hybrid_aggregator_mod

amgprec/amg_z_ilu_solver.f90

@@ -234,7 +234,7 @@ contains
     ! Arguments
     class(amg_z_ilu_solver_type), intent(inout) :: sv
 
-    sv%fact_type = psb_ilu_n_
+    sv%fact_type = amg_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',psb_ilu_n_,is_legal_ilu_fact)
+         & 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
 
     select case(sv%fact_type)
-    case(psb_ilu_n_,psb_milu_n_)      
+    case(amg_ilu_n_,amg_milu_n_)      
       call amg_check_def(sv%fill_in,&
            & 'Level',izero,is_int_non_negative)
-    case(psb_ilu_t_)                 
+    case(amg_ilu_t_)                 
       call amg_check_def(sv%thresh,&
            & 'Eps',dzero,is_legal_d_fact_thrs)
     end select
@@ -439,9 +439,9 @@ contains
     write(iout_,*) trim(prefix_), '  Incomplete factorization solver: ',&
          &  amg_fact_names(sv%fact_type)
     select case(sv%fact_type)
-    case(psb_ilu_n_,psb_milu_n_)      
+    case(amg_ilu_n_,amg_milu_n_)      
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-    case(psb_ilu_t_)         
+    case(amg_ilu_t_)         
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
       write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
     end select
@@ -496,7 +496,7 @@ contains
     implicit none 
     integer(psb_ipk_)  :: val
     
-    val = psb_ilu_n_
+    val = amg_ilu_n_
   end function z_ilu_solver_get_id
 
   function z_ilu_solver_get_wrksize() result(val)

amgprec/amg_z_inner_mod.f90

@@ -109,11 +109,12 @@ module amg_z_inner_mod
   end interface amg_map_to_tprol
 
   abstract interface
-    subroutine amg_zaggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_zaggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
          & ac,desc_ac,op_prol,op_restr,t_prol,info)
       import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_, psb_lpk_, psb_lzspmat_type
       import ::  amg_z_onelev_type, amg_dml_parms
       implicit none 
+      integer(psb_ipk_), intent(in)               :: dol1smoothing
       type(psb_zspmat_type), intent(in)         :: a
       type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)            :: ilaggr(:), nlaggr(:)

amgprec/amg_z_invk_solver.f90

@@ -52,6 +52,7 @@ module amg_z_invk_solver
   contains
     procedure, pass(sv) :: check   => amg_z_invk_solver_check
     procedure, pass(sv) :: clone   => amg_z_invk_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_z_invk_solver_clone_settings
     procedure, pass(sv) :: build   => amg_z_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_z_invk_solver_cseti
     procedure, pass(sv) :: descr   => amg_z_invk_solver_descr
@@ -73,6 +74,17 @@ module amg_z_invk_solver
     end subroutine amg_z_invk_solver_clone
   end interface
 
+  interface
+    subroutine amg_z_invk_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_invk_solver_type, psb_ipk_
+      Implicit None
+      class(amg_z_invk_solver_type), intent(inout) :: sv
+      class(amg_z_base_solver_type), intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                 :: info
+    end subroutine amg_z_invk_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_z_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &

amgprec/amg_z_invt_solver.f90

@@ -52,6 +52,7 @@ module amg_z_invt_solver
   contains
     procedure, pass(sv) :: check   => amg_z_invt_solver_check
     procedure, pass(sv) :: clone   => amg_z_invt_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_z_invt_solver_clone_settings
     procedure, pass(sv) :: build   => amg_z_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_z_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_z_invt_solver_csetr
@@ -73,6 +74,17 @@ module amg_z_invt_solver
     end subroutine amg_z_invt_solver_clone
   end interface
 
+  interface
+    subroutine amg_z_invt_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_invt_solver_type, psb_ipk_
+      Implicit None
+      class(amg_z_invt_solver_type), intent(inout) :: sv
+      class(amg_z_base_solver_type), intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                 :: info
+    end subroutine amg_z_invt_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_z_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &

amgprec/amg_z_jac_smoother.f90

@@ -203,8 +203,8 @@ module amg_z_jac_smoother
     subroutine amg_z_jac_smoother_clone_settings(sm,smout,info)
       import :: amg_z_jac_smoother_type, psb_dpk_, &
            & amg_z_base_smoother_type, psb_ipk_
-      class(amg_z_jac_smoother_type), intent(inout)               :: sm
-      class(amg_z_base_smoother_type), allocatable, intent(inout) :: smout
+      class(amg_z_jac_smoother_type), intent(inout)  :: sm
+      class(amg_z_base_smoother_type), intent(inout) :: smout
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_z_jac_smoother_clone_settings
   end interface

amgprec/amg_z_jac_solver.f90

@@ -0,0 +1,585 @@
+!  
+!   
+!                             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_z_jac_solver_mod.f90
+!
+! Module: amg_z_jac_solver_mod
+!
+!  This module defines: 
+!  - the amg_z_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_z_jac_solver
+
+  use amg_z_base_solver_mod
+
+  type, extends(amg_z_base_solver_type) :: amg_z_jac_solver_type
+    type(psb_zspmat_type)      :: a
+    type(psb_z_vect_type), allocatable :: dv
+    complex(psb_dpk_), allocatable        :: d(:)
+    integer(psb_ipk_)          :: sweeps
+    real(psb_dpk_)             :: eps
+  contains
+    procedure, pass(sv) :: dump    => amg_z_jac_solver_dmp
+    procedure, pass(sv) :: check   => z_jac_solver_check
+    procedure, pass(sv) :: clone   => amg_z_jac_solver_clone
+    procedure, pass(sv) :: clone_settings => amg_z_jac_solver_clone_settings
+    procedure, pass(sv) :: clear_data     => amg_z_jac_solver_clear_data
+    procedure, pass(sv) :: build   => amg_z_jac_solver_bld
+    procedure, pass(sv) :: cnv     => amg_z_jac_solver_cnv
+    procedure, pass(sv) :: apply_v => amg_z_jac_solver_apply_vect
+    procedure, pass(sv) :: apply_a => amg_z_jac_solver_apply
+    procedure, pass(sv) :: free    => z_jac_solver_free
+    procedure, pass(sv) :: cseti   => z_jac_solver_cseti
+    procedure, pass(sv) :: csetc   => z_jac_solver_csetc
+    procedure, pass(sv) :: csetr   => z_jac_solver_csetr
+    procedure, pass(sv) :: descr   => z_jac_solver_descr
+    procedure, pass(sv) :: default => z_jac_solver_default
+    procedure, pass(sv) :: sizeof  => z_jac_solver_sizeof
+    procedure, pass(sv) :: get_nzeros => z_jac_solver_get_nzeros
+    procedure, nopass   :: get_wrksz  => z_jac_solver_get_wrksize
+    procedure, nopass   :: get_fmt    => z_jac_solver_get_fmt
+    procedure, nopass   :: get_id     => z_jac_solver_get_id
+    procedure, nopass   :: is_iterative => z_jac_solver_is_iterative
+  end type amg_z_jac_solver_type
+
+  type, extends(amg_z_jac_solver_type) :: amg_z_l1_jac_solver_type
+  contains
+    procedure, pass(sv) :: build   => amg_z_l1_jac_solver_bld
+    procedure, pass(sv) :: descr   => z_l1_jac_solver_descr
+    procedure, nopass   :: get_fmt    => z_l1_jac_solver_get_fmt
+    procedure, nopass   :: get_id     => z_l1_jac_solver_get_id
+  end type amg_z_l1_jac_solver_type
+
+
+  private :: z_jac_solver_bld, z_jac_solver_apply, &
+       &  z_jac_solver_free,   &
+       &  z_jac_solver_descr,  z_jac_solver_sizeof, &
+       &  z_jac_solver_default, z_jac_solver_dmp, &
+       &  z_jac_solver_apply_vect, z_jac_solver_get_nzeros, &
+       &  z_jac_solver_get_fmt, z_jac_solver_check,&
+       &  z_jac_solver_is_iterative, &
+       &  z_jac_solver_get_id, z_jac_solver_get_wrksize
+
+  interface 
+    subroutine amg_z_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
+         & trans,work,wv,info,init,initu)
+      import :: psb_desc_type, amg_z_jac_solver_type, psb_z_vect_type, psb_dpk_, &
+           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
+      implicit none 
+      type(psb_desc_type), intent(in)             :: desc_data
+      class(amg_z_jac_solver_type), intent(inout) :: sv
+      type(psb_z_vect_type),intent(inout)         :: x
+      type(psb_z_vect_type),intent(inout)         :: y
+      complex(psb_dpk_),intent(in)                    :: alpha,beta
+      character(len=1),intent(in)                   :: trans
+      complex(psb_dpk_),target, intent(inout)         :: work(:)
+      type(psb_z_vect_type),intent(inout)         :: wv(:)
+      integer(psb_ipk_), intent(out)                :: info
+      character, intent(in), optional                :: init
+      type(psb_z_vect_type),intent(inout), optional   :: initu
+    end subroutine amg_z_jac_solver_apply_vect
+  end interface
+
+  interface 
+    subroutine amg_z_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
+      import :: psb_desc_type, amg_z_jac_solver_type, psb_z_vect_type, psb_dpk_, &
+           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
+      implicit none 
+      type(psb_desc_type), intent(in)      :: desc_data
+      class(amg_z_jac_solver_type), intent(inout) :: sv
+      complex(psb_dpk_),intent(inout)         :: x(:)
+      complex(psb_dpk_),intent(inout)         :: y(:)
+      complex(psb_dpk_),intent(in)            :: alpha,beta
+      character(len=1),intent(in)           :: trans
+      complex(psb_dpk_),target, intent(inout) :: work(:)
+      integer(psb_ipk_), intent(out)        :: info
+      character, intent(in), optional       :: init
+      complex(psb_dpk_),intent(inout), optional :: initu(:)
+    end subroutine amg_z_jac_solver_apply
+  end interface
+
+  interface 
+    subroutine amg_z_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
+      import :: psb_desc_type, amg_z_jac_solver_type, psb_z_vect_type, psb_dpk_, &
+           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
+           & psb_ipk_, psb_i_base_vect_type
+      implicit none 
+      type(psb_zspmat_type), intent(in), target           :: a
+      Type(psb_desc_type), Intent(inout)                  :: desc_a 
+      class(amg_z_jac_solver_type), intent(inout)         :: sv
+      integer(psb_ipk_), intent(out)                      :: info
+      type(psb_zspmat_type), intent(in), target, optional :: b
+      class(psb_z_base_sparse_mat), intent(in), optional  :: amold
+      class(psb_z_base_vect_type), intent(in), optional   :: vmold
+      class(psb_i_base_vect_type), intent(in), optional   :: imold
+    end subroutine amg_z_jac_solver_bld
+  end interface
+
+  interface 
+    subroutine amg_z_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
+      import :: psb_desc_type, amg_z_l1_jac_solver_type, psb_z_vect_type, psb_dpk_, &
+           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
+           & psb_ipk_, psb_i_base_vect_type
+      implicit none 
+      type(psb_zspmat_type), intent(in), target           :: a
+      Type(psb_desc_type), Intent(inout)                  :: desc_a 
+      class(amg_z_l1_jac_solver_type), intent(inout)         :: sv
+      integer(psb_ipk_), intent(out)                      :: info
+      type(psb_zspmat_type), intent(in), target, optional :: b
+      class(psb_z_base_sparse_mat), intent(in), optional  :: amold
+      class(psb_z_base_vect_type), intent(in), optional   :: vmold
+      class(psb_i_base_vect_type), intent(in), optional   :: imold
+    end subroutine amg_z_l1_jac_solver_bld
+  end interface
+
+  interface 
+    subroutine amg_z_jac_solver_cnv(sv,info,amold,vmold,imold)
+      import :: amg_z_jac_solver_type, psb_dpk_, &
+           & psb_z_base_sparse_mat, psb_z_base_vect_type,&
+           & psb_ipk_, psb_i_base_vect_type
+      implicit none 
+      class(amg_z_jac_solver_type), intent(inout)         :: sv
+      integer(psb_ipk_), intent(out)                      :: info
+      class(psb_z_base_sparse_mat), intent(in), optional  :: amold
+      class(psb_z_base_vect_type), intent(in), optional   :: vmold
+      class(psb_i_base_vect_type), intent(in), optional   :: imold
+    end subroutine amg_z_jac_solver_cnv
+  end interface
+  
+  interface 
+    subroutine amg_z_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
+      import :: psb_desc_type, amg_z_jac_solver_type, psb_z_vect_type, psb_dpk_, &
+           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, &
+           & psb_ipk_
+      implicit none 
+      class(amg_z_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_z_jac_solver_dmp
+  end interface
+  
+  interface
+    subroutine amg_z_jac_solver_clone(sv,svout,info)
+      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_solver_type, amg_z_jac_solver_type, psb_ipk_
+      Implicit None
+      
+      ! Arguments
+      class(amg_z_jac_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_jac_solver_clone
+  end interface
+  
+!!$  interface
+!!$    subroutine amg_z_l1_jac_solver_clone(sv,svout,info)
+!!$      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_solver_type, amg_z_l1_jac_solver_type, psb_ipk_
+!!$      Implicit None
+!!$      
+!!$      ! Arguments
+!!$      class(amg_z_l1_jac_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_l1_jac_solver_clone
+!!$  end interface
+
+  interface
+    subroutine amg_z_jac_solver_clone_settings(sv,svout,info)
+      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_solver_type, amg_z_jac_solver_type, psb_ipk_
+      Implicit None
+      
+      ! Arguments
+      class(amg_z_jac_solver_type), intent(inout) :: sv
+      class(amg_z_base_solver_type), intent(inout) :: svout
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_z_jac_solver_clone_settings
+  end interface
+
+  interface
+    subroutine amg_z_jac_solver_clear_data(sv,info)
+      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_jac_solver_type, psb_ipk_
+      Implicit None
+      
+      ! Arguments
+      class(amg_z_jac_solver_type), intent(inout) :: sv
+      integer(psb_ipk_), intent(out)                 :: info
+    end subroutine amg_z_jac_solver_clear_data
+  end interface
+
+contains
+
+  subroutine z_jac_solver_default(sv)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_jac_solver_type), intent(inout) :: sv
+
+    sv%sweeps = ione
+    sv%eps    = dzero
+    
+    return
+  end subroutine z_jac_solver_default
+
+  subroutine z_jac_solver_check(sv,info)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_jac_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_) :: err_act
+    character(len=20) :: name='z_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 z_jac_solver_check
+
+  subroutine z_jac_solver_cseti(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_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='z_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_z_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 z_jac_solver_cseti
+
+  subroutine z_jac_solver_csetc(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_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='z_jac_solver_csetc'
+
+    info = psb_success_
+    call psb_erractionsave(err_act)
+
+
+    call sv%amg_z_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 z_jac_solver_csetc
+  
+  subroutine z_jac_solver_csetr(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_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='z_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_z_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 z_jac_solver_csetr
+
+  subroutine z_jac_solver_free(sv,info)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_jac_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_)  :: err_act
+    character(len=20)  :: name='z_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 z_jac_solver_free
+
+  subroutine z_jac_solver_descr(sv,info,iout,coarse,prefix)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_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_z_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 z_jac_solver_descr
+
+  function z_jac_solver_get_nzeros(sv) result(val)
+
+    implicit none 
+    ! Arguments
+    class(amg_z_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 z_jac_solver_get_nzeros
+
+  function z_jac_solver_sizeof(sv) result(val)
+
+    implicit none 
+    ! Arguments
+    class(amg_z_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 z_jac_solver_sizeof
+
+  function z_jac_solver_get_fmt() result(val)
+    implicit none 
+    character(len=32)  :: val
+
+    val = "Jacobi solver"
+  end function z_jac_solver_get_fmt
+
+  function z_jac_solver_get_id() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = amg_jac_
+  end function z_jac_solver_get_id
+
+  !
+  ! If this is true, then the solver needs a starting
+  ! guess. Currently only handled in JAC smoother. 
+  ! 
+  function z_jac_solver_is_iterative() result(val)
+    implicit none 
+    logical  :: val
+
+    val = .true.
+  end function z_jac_solver_is_iterative
+    
+  function z_jac_solver_get_wrksize() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = 2
+  end function z_jac_solver_get_wrksize
+
+  subroutine z_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_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_z_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 z_l1_jac_solver_descr
+
+  function z_l1_jac_solver_get_fmt() result(val)
+    implicit none 
+    character(len=32)  :: val
+
+    val = "L1-Jacobi solver"
+  end function z_l1_jac_solver_get_fmt
+
+  function z_l1_jac_solver_get_id() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = amg_l1_jac_
+  end function z_l1_jac_solver_get_id
+  
+end module amg_z_jac_solver

amgprec/amg_z_krm_solver.f90

@@ -473,7 +473,7 @@ contains
     end if
     write(iout_,*) trim(prefix_), '    method: ',sv%method
     write(iout_,*) trim(prefix_), '     kprec: ',sv%kprec
-    call sv%prec%descr(iout_,info,prefix='KRM : '//prefix_)
+    call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
     write(iout_,*) trim(prefix_), '     itmax: ',sv%itmax
     write(iout_,*) trim(prefix_), '       eps: ',sv%eps
 

amgprec/amg_z_mumps_solver.F90

@@ -78,7 +78,8 @@ module amg_z_mumps_solver
     !
     ! Controls to be set before MUMPS instantiation:
     !
-    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: LOCAL   1==amg_global_solver_: GLOBAL
+    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: 'LOCAL_SOLVER
+    !                            1==amg_global_solver_: 'GLOBAL_SOLVER'
     ! IPAR(2) : MUMPS_PRINT_ERR  print verbosity (see MUMPS)
     ! IPAR(3) : MUMPS_SYM        0: non-symmetric   2: symmetric
     integer(psb_ipk_), dimension(3) :: ipar

amgprec/amg_z_onelev_mod.f90

@@ -187,8 +187,10 @@ module amg_z_onelev_mod
     procedure, pass(lv) :: clone   => z_base_onelev_clone
     procedure, pass(lv) :: cnv     => amg_z_base_onelev_cnv
     procedure, pass(lv) :: descr   => amg_z_base_onelev_descr
+    procedure, pass(lv) :: memory_use  => amg_z_base_onelev_memory_use
     procedure, pass(lv) :: default => z_base_onelev_default
     procedure, pass(lv) :: free    => amg_z_base_onelev_free
+    procedure, pass(lv) :: free_smoothers => amg_z_base_onelev_free_smoothers
     procedure, pass(lv) :: nullify => z_base_onelev_nullify
     procedure, pass(lv) :: check => amg_z_base_onelev_check
     procedure, pass(lv) :: dump  => amg_z_base_onelev_dump
@@ -272,6 +274,23 @@ module amg_z_onelev_mod
     end subroutine amg_z_base_onelev_descr
   end interface
 
+  interface
+    subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
+      import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
+           & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
+           & psb_ipk_, psb_epk_, psb_desc_type
+      Implicit None
+      ! Arguments
+      class(amg_z_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_z_base_onelev_memory_use
+  end interface
+
   interface
     subroutine amg_z_base_onelev_cnv(lv,info,amold,vmold,imold)
       import :: amg_z_onelev_type, psb_z_base_vect_type, psb_dpk_, &
@@ -285,7 +304,7 @@ module amg_z_onelev_mod
     end subroutine amg_z_base_onelev_cnv
   end interface
 
-interface
+  interface
     subroutine amg_z_base_onelev_free(lv,info)
       import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
            & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
@@ -297,6 +316,18 @@ interface
     end subroutine amg_z_base_onelev_free
   end interface
 
+  interface
+    subroutine amg_z_base_onelev_free_smoothers(lv,info)
+      import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
+           & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
+           & psb_ipk_, psb_epk_, psb_desc_type
+      implicit none
+
+      class(amg_z_onelev_type), intent(inout) :: lv
+      integer(psb_ipk_), intent(out)                :: info
+    end subroutine amg_z_base_onelev_free_smoothers
+  end interface
+
   interface
     subroutine amg_z_base_onelev_check(lv,info)
       import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &

amgprec/amg_z_prec_type.f90

@@ -135,8 +135,11 @@ module amg_z_prec_type
     procedure, pass(prec)               :: build        => amg_zprecbld
     procedure, pass(prec)               :: hierarchy_build   => amg_z_hierarchy_bld
     procedure, pass(prec)               :: hierarchy_rebuild => amg_z_hierarchy_rebld
+    procedure, pass(prec)               :: hierarchy_free    => amg_z_hierarchy_free    
     procedure, pass(prec)               :: smoothers_build   => amg_z_smoothers_bld
+    procedure, pass(prec)               :: smoothers_free    => amg_z_smoothers_free
     procedure, pass(prec)               :: descr        =>  amg_zfile_prec_descr
+    procedure, pass(prec)               :: memory_use   =>  amg_zfile_prec_memory_use
   end type amg_zprec_type
 
   private :: amg_z_dump, amg_z_get_compl,  amg_z_cmp_compl,&
@@ -168,6 +171,22 @@ module amg_z_prec_type
     end subroutine amg_zfile_prec_descr
   end interface
 
+  
+  interface amg_memory_use
+    subroutine amg_zfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
+      import :: amg_zprec_type, psb_ipk_
+      implicit none
+      ! Arguments
+      class(amg_zprec_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_zfile_prec_memory_use
+  end interface
+
   interface amg_sizeof
     module procedure amg_zprec_sizeof
   end interface
@@ -345,6 +364,14 @@ module amg_z_prec_type
     end subroutine amg_z_smoothers_bld
   end interface amg_smoothers_bld
 
+  interface amg_smoothers_free
+    module procedure  amg_z_smoothers_free
+  end interface amg_smoothers_free
+
+  interface amg_hierarchy_free
+    module procedure amg_z_hierarchy_free
+  end interface amg_hierarchy_free
+
 contains
   !
   ! Function returning a pointer to the smoother
@@ -618,6 +645,68 @@ contains
 
   end subroutine amg_z_prec_free
 
+  subroutine amg_z_smoothers_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_zprec_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_z_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_z_smoothers_free
+
+  subroutine amg_z_hierarchy_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_zprec_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_z_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_z_hierarchy_free
 
 
   !

amgprec/impl/Makefile

@@ -22,22 +22,22 @@ MPFOBJS=$(SMPFOBJS) $(DMPFOBJS) $(CMPFOBJS) $(ZMPFOBJS)
 MPCOBJS=amg_dslud_interface.o amg_zslud_interface.o
 
 
-DINNEROBJS= amg_dmlprec_bld.o amg_dfile_prec_descr.o \
+DINNEROBJS= amg_dmlprec_bld.o amg_dfile_prec_descr.o amg_dfile_prec_memory_use.o \
 	amg_d_smoothers_bld.o amg_d_hierarchy_bld.o amg_d_hierarchy_rebld.o \
 	amg_dmlprec_aply.o   \
 	$(DMPFOBJS) amg_d_extprol_bld.o
 
-SINNEROBJS=   amg_smlprec_bld.o amg_sfile_prec_descr.o \
+SINNEROBJS=   amg_smlprec_bld.o amg_sfile_prec_descr.o amg_sfile_prec_memory_use.o \
 	amg_s_smoothers_bld.o amg_s_hierarchy_bld.o amg_s_hierarchy_rebld.o \
 	amg_smlprec_aply.o   \
 	$(SMPFOBJS) amg_s_extprol_bld.o 
 
-ZINNEROBJS=   amg_zmlprec_bld.o amg_zfile_prec_descr.o \
+ZINNEROBJS=   amg_zmlprec_bld.o amg_zfile_prec_descr.o amg_zfile_prec_memory_use.o \
 	amg_z_smoothers_bld.o amg_z_hierarchy_bld.o amg_z_hierarchy_rebld.o \
 	amg_zmlprec_aply.o   \
 	$(ZMPFOBJS)  amg_z_extprol_bld.o
 
-CINNEROBJS=   amg_cmlprec_bld.o amg_cfile_prec_descr.o \
+CINNEROBJS=   amg_cmlprec_bld.o amg_cfile_prec_descr.o amg_cfile_prec_memory_use.o \
 	amg_c_smoothers_bld.o amg_c_hierarchy_bld.o amg_c_hierarchy_rebld.o \
 	amg_cmlprec_aply.o   \
 	$(CMPFOBJS)  amg_c_extprol_bld.o
@@ -67,22 +67,25 @@ OBJS=$(F90OBJS) $(COBJS) $(MPCOBJS)
 
 LIBNAME=libamg_prec.a
 
+objs: $(OBJS) aggrd levd smoothd solvd
+
 lib:  $(OBJS) aggrd levd smoothd solvd
+	cd aggregator && $(MAKE) lib
+	cd level && $(MAKE) lib
+	cd smoother && $(MAKE) lib
+	cd solver && $(MAKE) lib
 	$(AR) $(HERE)/$(LIBNAME) $(OBJS)
 	$(RANLIB) $(HERE)/$(LIBNAME)
 
 aggrd:
-	$(MAKE) -C aggregator
+	cd aggregator && $(MAKE) objs
 levd:
-	$(MAKE) -C level
+	cd level && $(MAKE)  objs
 smoothd:
-	$(MAKE) -C smoother
+	cd smoother   && $(MAKE)  objs
 solvd:
-	$(MAKE) -C solver
+	cd solver && $(MAKE)  objs
 
-mpobjs: 
-	(make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)")
-	(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
 
 veryclean: clean
 	/bin/rm -f $(LIBNAME)
@@ -91,10 +94,10 @@ clean: solvclean smoothclean levclean aggrclean
 	/bin/rm -f $(OBJS) $(LOCAL_MODS)
 
 aggrclean:
-		$(MAKE) -C aggregator clean
+	cd aggregator && $(MAKE) clean
 levclean:
-		$(MAKE) -C level clean
+	cd level && $(MAKE) clean
 smoothclean:
-		$(MAKE) -C smoother clean
+	cd smoother && 	$(MAKE)  clean
 solvclean:
-		$(MAKE) -C solver clean
+	cd solver && $(MAKE)  clean

amgprec/impl/aggregator/Makefile

@@ -62,13 +62,30 @@ amg_s_parmatch_smth_bld.o \
 amg_s_parmatch_spmm_bld_inner.o
 
 MPCOBJS=MatchBoxPC.o \
-algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o
+sendBundledMessages.o \
+initialize.o \
+extractUChunk.o \
+isAlreadyMatched.o \
+findOwnerOfGhost.o \
+clean.o \
+computeCandidateMate.o \
+parallelComputeCandidateMateB.o \
+processMatchedVertices.o \
+processMatchedVerticesAndSendMessages.o \
+processCrossEdge.o \
+queueTransfer.o \
+processMessages.o \
+processExposedVertex.o \
+algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o \
+algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.o
 
 OBJS = $(FOBJS) $(MPCOBJS)
 
 LIBNAME=libamg_prec.a
 
-lib:  $(OBJS)
+objs: $(OBJS)
+
+lib:  objs
 	$(AR) $(HERE)/$(LIBNAME) $(OBJS)
 	$(RANLIB) $(HERE)/$(LIBNAME)
 

amgprec/impl/aggregator/MatchBoxPC.cpp

@@ -60,17 +60,43 @@ void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
 		MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
 #if !defined(SERIAL_MPI)
   MPI_Comm C_comm=MPI_Comm_f2c(icomm);
+
 #ifdef DEBUG
   fprintf(stderr,"MatchBoxPC: rank %d nlver %ld nledge %ld [ %ld %ld ]\n",
 	  myRank,NLVer, NLEdge,verDistance[0],verDistance[1]);
 #endif
-  dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(NLVer, NLEdge,
+
+
+#undef TIME_TRACKER
+#ifdef TIME_TRACKER
+  double tmr = MPI_Wtime();
+#endif
+
+#if defined(OPENMP)
+	//fprintf(stderr,"Warning: using buggy OpenMP matching!\n");
+        dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(NLVer, NLEdge,
 							   verLocPtr, verLocInd, edgeLocWeight,
 							   verDistance,  Mate,
 							   myRank, numProcs, C_comm,
 							   msgIndSent, msgActualSent, msgPercent,
 							   ph0_time, ph1_time, ph2_time,
 							   ph1_card, ph2_card );
+#else
+        dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(NLVer, NLEdge,
+							   verLocPtr, verLocInd, edgeLocWeight,
+							   verDistance,  Mate,
+							   myRank, numProcs, C_comm,
+							   msgIndSent, msgActualSent, msgPercent,
+							   ph0_time, ph1_time, ph2_time,
+							   ph1_card, ph2_card );
+#endif
+
+
+#ifdef TIME_TRACKER
+	tmr = MPI_Wtime() - tmr;
+	fprintf(stderr, "Elaboration time: %f for %ld nodes\n", tmr, NLVer);
+#endif
+	
 #endif
 }
 
@@ -88,13 +114,24 @@ void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
   fprintf(stderr,"MatchBoxPC: rank %d nlver %ld nledge %ld [ %ld %ld ]\n",
 	  myRank,NLVer, NLEdge,verDistance[0],verDistance[1]);
 #endif
+#if defined(OPENMP)
+	//fprintf(stderr,"Warning: using buggy OpenMP matching!\n");
+  salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(NLVer, NLEdge,
+							      verLocPtr, verLocInd, edgeLocWeight,
+							      verDistance,  Mate,
+							      myRank, numProcs, C_comm,
+							      msgIndSent, msgActualSent, msgPercent,
+							      ph0_time, ph1_time, ph2_time,
+							      ph1_card, ph2_card );
+#else
   salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(NLVer, NLEdge,
-							   verLocPtr, verLocInd, edgeLocWeight,
-							   verDistance,  Mate,
-							   myRank, numProcs, C_comm,
-							   msgIndSent, msgActualSent, msgPercent,
-							   ph0_time, ph1_time, ph2_time,
-							   ph1_card, ph2_card );
+							    verLocPtr, verLocInd, edgeLocWeight,
+							    verDistance,  Mate,
+							    myRank, numProcs, C_comm,
+							    msgIndSent, msgActualSent, msgPercent,
+							    ph0_time, ph1_time, ph2_time,
+							    ph1_card, ph2_card );
+#endif
 #endif
 }
 

amgprec/impl/aggregator/MatchBoxPC.h

@@ -52,145 +52,583 @@
 
 #ifndef _matchboxpC_H_
 #define _matchboxpC_H_
-//Turn on a lot of debugging information with this switch:
+// Turn on a lot of debugging information with this switch:
 //#define PRINT_DEBUG_INFO_
 #include <stdio.h>
 #include <iostream>
 #include <assert.h>
 #include <map>
 #include <vector>
-// #include "matchboxp.h"
+#ifdef OPENMP
+// OpenMP is included and used if and only if the OpenMP version of the matching
+// is required
+#include "omp.h"
+#endif
 #include "primitiveDataTypeDefinitions.h"
 #include "dataStrStaticQueue.h"
 
 using namespace std;
 
+const int NUM_THREAD = 4;
+const int UCHUNK = 10;
+
+const MilanLongInt REQUEST = 1;
+const MilanLongInt SUCCESS = 2;
+const MilanLongInt FAILURE = 3;
+const MilanLongInt SIZEINFO = 4;
+
+const int ComputeTag = 7; // Predefined tag
+const int BundleTag = 9;  // Predefined tag
+
+static vector<MilanLongInt> DEFAULT_VECTOR;
+
+#if !defined(SERIAL_MPI)
+
+// MPI type map
+template <typename T>
+MPI_Datatype TypeMap();
+template <>
+inline MPI_Datatype TypeMap<int64_t>() { return MPI_LONG_LONG; }
+template <>
+inline MPI_Datatype TypeMap<int>() { return MPI_INT; }
+template <>
+inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
+template <>
+inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
+#endif
+
 #ifdef __cplusplus
-extern "C" {
+extern "C"
+{
 #endif
 
 #if !defined(SERIAL_MPI)
-  
-#define MilanMpiLongInt  MPI_LONG_LONG
+
+#define MilanMpiLongInt MPI_LONG_LONG
 
 #ifndef _primitiveDataType_Definition_
 #define _primitiveDataType_Definition_
-    //Regular integer:
-    #ifndef INTEGER_H
-    #define INTEGER_H
-        typedef int32_t MilanInt;
-    #endif
+// Regular integer:
+#ifndef INTEGER_H
+#define INTEGER_H
+    typedef int32_t MilanInt;
+#endif
 
-    //Regular long integer:
-    #ifndef LONG_INT_H
-    #define LONG_INT_H
-        #ifdef BIT64
-            typedef int64_t MilanLongInt;
-            typedef MPI_LONG MilanMpiLongInt;
-        #else
-            typedef int32_t MilanLongInt;
-            typedef MPI_INT MilanMpiLongInt;
-        #endif
-    #endif
+// Regular long integer:
+#ifndef LONG_INT_H
+#define LONG_INT_H
+#ifdef BIT64
+    typedef int64_t MilanLongInt;
+    typedef MPI_LONG MilanMpiLongInt;
+#else
+    typedef int32_t MilanLongInt;
+    typedef MPI_INT MilanMpiLongInt;
+#endif
+#endif
 
-    //Regular boolean
-    #ifndef BOOL_H
-    #define BOOL_H
-        typedef bool MilanBool;
-    #endif
+// Regular boolean
+#ifndef BOOL_H
+#define BOOL_H
+    typedef bool MilanBool;
+#endif
 
-    //Regular double and absolute value computation:
-    #ifndef REAL_H
-    #define REAL_H
-        typedef double MilanReal;
-        typedef MPI_DOUBLE MilanMpiReal;
-        inline MilanReal MilanAbs(MilanReal value)
-        {
-            return fabs(value);
-        }
-    #endif
+// Regular double and absolute value computation:
+#ifndef REAL_H
+#define REAL_H
+    typedef double MilanReal;
+    typedef MPI_DOUBLE MilanMpiReal;
+    inline MilanReal MilanAbs(MilanReal value)
+    {
+        return fabs(value);
+    }
+#endif
 
-    //Regular float and absolute value computation:
-    #ifndef FLOAT_H
-    #define FLOAT_H
-        typedef float MilanFloat;
-        typedef MPI_FLOAT MilanMpiFloat;
-        inline MilanFloat MilanAbsFloat(MilanFloat value)
-        {
-            return fabs(value);
-        }
-    #endif
+// Regular float and absolute value computation:
+#ifndef FLOAT_H
+#define FLOAT_H
+    typedef float MilanFloat;
+    typedef MPI_FLOAT MilanMpiFloat;
+    inline MilanFloat MilanAbsFloat(MilanFloat value)
+    {
+        return fabs(value);
+    }
+#endif
 
-    //// Define the limits:
-    #ifndef LIMITS_H
-    #define LIMITS_H
-    //Integer Maximum and Minimum:
-  //      #define MilanIntMax INT_MAX
-  //    #define MilanIntMin INT_MIN
-        #define MilanIntMax INT32_MAX
-        #define MilanIntMin INT32_MIN
+//// Define the limits:
+#ifndef LIMITS_H
+#define LIMITS_H
+    // Integer Maximum and Minimum:
+    //      #define MilanIntMax INT_MAX
+    //    #define MilanIntMin INT_MIN
+#define MilanIntMax INT32_MAX
+#define MilanIntMin INT32_MIN
 
-        #ifdef BIT64
-            #define MilanLongIntMax INT64_MAX
-            #define MilanLongIntMin -INT64_MAX
-        #else
-            #define MilanLongIntMax INT32_MAX
-            #define MilanLongIntMin -INT32_MAX
-        #endif
+#ifdef BIT64
+#define MilanLongIntMax INT64_MAX
+#define MilanLongIntMin -INT64_MAX
+#else
+#define MilanLongIntMax INT32_MAX
+#define MilanLongIntMin -INT32_MAX
+#endif
 
-    #endif
+#endif
 
     // +INFINITY
     const double PLUS_INFINITY = numeric_limits<int>::infinity();
     const double MINUS_INFINITY = -PLUS_INFINITY;
-    //#define MilanRealMax LDBL_MAX
-    #define MilanRealMax PLUS_INFINITY
-    #define MilanRealMin MINUS_INFINITY
+//#define MilanRealMax LDBL_MAX
+#define MilanRealMax PLUS_INFINITY
+#define MilanRealMin MINUS_INFINITY
 #endif
 
-//Function of find the owner of a ghost vertex using binary search:
-inline MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
-                                     MilanInt myRank, MilanInt numProcs);
+/* These functions are only used in the experimental OMP implementation, if that
+is disabled there is no reason to actually compile or reference them. */
 
-  void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC
-(
- MilanLongInt NLVer, MilanLongInt NLEdge,
- MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight,
- MilanLongInt* verDistance,
- MilanLongInt* Mate,
- MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
- MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
- MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
- MilanLongInt* ph1_card, MilanLongInt* ph2_card );
+  // Function of find the owner of a ghost vertex using binary search:
+  MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
+			    MilanInt myRank, MilanInt numProcs);
+  
+  MilanLongInt firstComputeCandidateMateD(MilanLongInt adj1,
+					 MilanLongInt adj2,
+					 MilanLongInt *verLocInd,
+					 MilanReal *edgeLocWeight);
 
- void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC
-(
-MilanLongInt NLVer, MilanLongInt NLEdge,
-MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight,
-MilanLongInt* verDistance,
-MilanLongInt* Mate,
-MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
-MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
-MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
-MilanLongInt* ph1_card, MilanLongInt* ph2_card );
+  
+  void queuesTransfer(vector<MilanLongInt> &U,
+		      vector<MilanLongInt> &privateU,
+		      vector<MilanLongInt> &QLocalVtx,
+		      vector<MilanLongInt> &QGhostVtx,
+		      vector<MilanLongInt> &QMsgType,
+		      vector<MilanInt> &QOwner,
+		      vector<MilanLongInt> &privateQLocalVtx,
+		      vector<MilanLongInt> &privateQGhostVtx,
+		      vector<MilanLongInt> &privateQMsgType,
+		      vector<MilanInt> &privateQOwner);
+  
+  bool isAlreadyMatched(MilanLongInt node,
+			MilanLongInt StartIndex,
+			MilanLongInt EndIndex,
+			vector<MilanLongInt> &GMate,
+			MilanLongInt *Mate,
+			map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
+  
+  MilanLongInt computeCandidateMateD(MilanLongInt adj1,
+				    MilanLongInt adj2,
+				    MilanReal *edgeLocWeight,
+				    MilanLongInt k,
+				    MilanLongInt *verLocInd,
+				    MilanLongInt StartIndex,
+				    MilanLongInt EndIndex,
+				    vector<MilanLongInt> &GMate,
+				    MilanLongInt *Mate,
+				    map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
+  
+  void initialize(MilanLongInt NLVer, MilanLongInt NLEdge,
+		  MilanLongInt StartIndex, MilanLongInt EndIndex,
+		  MilanLongInt *numGhostEdgesPtr,
+		  MilanLongInt *numGhostVerticesPtr,
+		  MilanLongInt *S,
+		  MilanLongInt *verLocInd,
+		  MilanLongInt *verLocPtr,
+		  map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+		  vector<MilanLongInt> &Counter,
+		  vector<MilanLongInt> &verGhostPtr,
+		  vector<MilanLongInt> &verGhostInd,
+		  vector<MilanLongInt> &tempCounter,
+		  vector<MilanLongInt> &GMate,
+		  vector<MilanLongInt> &Message,
+		  vector<MilanLongInt> &QLocalVtx,
+		  vector<MilanLongInt> &QGhostVtx,
+		  vector<MilanLongInt> &QMsgType,
+		  vector<MilanInt> &QOwner,
+		  MilanLongInt *&candidateMate,
+		  vector<MilanLongInt> &U,
+		  vector<MilanLongInt> &privateU,
+		  vector<MilanLongInt> &privateQLocalVtx,
+		  vector<MilanLongInt> &privateQGhostVtx,
+		  vector<MilanLongInt> &privateQMsgType,
+		  vector<MilanInt> &privateQOwner);
+  
+  void clean(MilanLongInt NLVer,
+	     MilanInt myRank,
+	     MilanLongInt MessageIndex,
+	     vector<MPI_Request> &SRequest,
+	     vector<MPI_Status> &SStatus,
+	     MilanInt BufferSize,
+	     MilanLongInt *Buffer,
+	     MilanLongInt msgActual,
+	     MilanLongInt *msgActualSent,
+	     MilanLongInt msgInd,
+	     MilanLongInt *msgIndSent,
+	     MilanLongInt NumMessagesBundled,
+	     MilanReal *msgPercent);
+  
+  void PARALLEL_COMPUTE_CANDIDATE_MATE_BD(MilanLongInt NLVer,
+					 MilanLongInt *verLocPtr,
+					 MilanLongInt *verLocInd,
+					 MilanInt myRank,
+					 MilanReal *edgeLocWeight,
+					 MilanLongInt *candidateMate);
+  
+  void PARALLEL_PROCESS_EXPOSED_VERTEX_BD(MilanLongInt NLVer,
+					 MilanLongInt *candidateMate,
+					 MilanLongInt *verLocInd,
+					 MilanLongInt *verLocPtr,
+					 MilanLongInt StartIndex,
+					 MilanLongInt EndIndex,
+					 MilanLongInt *Mate,
+					 vector<MilanLongInt> &GMate,
+					 map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+					 MilanReal *edgeLocWeight,
+					 MilanLongInt *myCardPtr,
+					 MilanLongInt *msgIndPtr,
+					 MilanLongInt *NumMessagesBundledPtr,
+					 MilanLongInt *SPtr,
+					 MilanLongInt *verDistance,
+					 MilanLongInt *PCounter,
+					 vector<MilanLongInt> &Counter,
+					 MilanInt myRank,
+					 MilanInt numProcs,
+					 vector<MilanLongInt> &U,
+					 vector<MilanLongInt> &privateU,
+					 vector<MilanLongInt> &QLocalVtx,
+					 vector<MilanLongInt> &QGhostVtx,
+					 vector<MilanLongInt> &QMsgType,
+					 vector<MilanInt> &QOwner,
+					 vector<MilanLongInt> &privateQLocalVtx,
+					 vector<MilanLongInt> &privateQGhostVtx,
+					 vector<MilanLongInt> &privateQMsgType,
+					 vector<MilanInt> &privateQOwner);
+  
+  void PROCESS_CROSS_EDGE(MilanLongInt *edge,
+			  MilanLongInt *SPtr);
+  
+  void processMatchedVerticesD(
+			      MilanLongInt NLVer,
+			      vector<MilanLongInt> &UChunkBeingProcessed,
+			      vector<MilanLongInt> &U,
+			      vector<MilanLongInt> &privateU,
+			      MilanLongInt StartIndex,
+			      MilanLongInt EndIndex,
+			      MilanLongInt *myCardPtr,
+			      MilanLongInt *msgIndPtr,
+			      MilanLongInt *NumMessagesBundledPtr,
+			      MilanLongInt *SPtr,
+			      MilanLongInt *verLocPtr,
+			      MilanLongInt *verLocInd,
+			      MilanLongInt *verDistance,
+			      MilanLongInt *PCounter,
+			      vector<MilanLongInt> &Counter,
+			      MilanInt myRank,
+			      MilanInt numProcs,
+			      MilanLongInt *candidateMate,
+			      vector<MilanLongInt> &GMate,
+			      MilanLongInt *Mate,
+			      map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+			      MilanReal *edgeLocWeight,
+			      vector<MilanLongInt> &QLocalVtx,
+			      vector<MilanLongInt> &QGhostVtx,
+			      vector<MilanLongInt> &QMsgType,
+			      vector<MilanInt> &QOwner,
+			      vector<MilanLongInt> &privateQLocalVtx,
+			      vector<MilanLongInt> &privateQGhostVtx,
+			      vector<MilanLongInt> &privateQMsgType,
+			      vector<MilanInt> &privateQOwner);
+  
+  void processMatchedVerticesAndSendMessagesD(
+					     MilanLongInt NLVer,
+					     vector<MilanLongInt> &UChunkBeingProcessed,
+					     vector<MilanLongInt> &U,
+					     vector<MilanLongInt> &privateU,
+					     MilanLongInt StartIndex,
+					     MilanLongInt EndIndex,
+					     MilanLongInt *myCardPtr,
+					     MilanLongInt *msgIndPtr,
+					     MilanLongInt *NumMessagesBundledPtr,
+					     MilanLongInt *SPtr,
+					     MilanLongInt *verLocPtr,
+					     MilanLongInt *verLocInd,
+					     MilanLongInt *verDistance,
+					     MilanLongInt *PCounter,
+					     vector<MilanLongInt> &Counter,
+					     MilanInt myRank,
+					     MilanInt numProcs,
+					     MilanLongInt *candidateMate,
+					     vector<MilanLongInt> &GMate,
+					     MilanLongInt *Mate,
+					     map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+					     MilanReal *edgeLocWeight,
+					     vector<MilanLongInt> &QLocalVtx,
+					     vector<MilanLongInt> &QGhostVtx,
+					     vector<MilanLongInt> &QMsgType,
+					     vector<MilanInt> &QOwner,
+					     vector<MilanLongInt> &privateQLocalVtx,
+					     vector<MilanLongInt> &privateQGhostVtx,
+					     vector<MilanLongInt> &privateQMsgType,
+					     vector<MilanInt> &privateQOwner,
+					     MPI_Comm comm,
+					     MilanLongInt *msgActual,
+					     vector<MilanLongInt> &Message);
+  
+  void sendBundledMessages(MilanLongInt *numGhostEdgesPtr,
+			   MilanInt *BufferSizePtr,
+			   MilanLongInt *Buffer,
+			   vector<MilanLongInt> &PCumulative,
+			   vector<MilanLongInt> &PMessageBundle,
+			   vector<MilanLongInt> &PSizeInfoMessages,
+			   MilanLongInt *PCounter,
+			   MilanLongInt NumMessagesBundled,
+			   MilanLongInt *msgActualPtr,
+			   MilanLongInt *MessageIndexPtr,
+			   MilanInt numProcs,
+			   MilanInt myRank,
+			   MPI_Comm comm,
+			   vector<MilanLongInt> &QLocalVtx,
+			   vector<MilanLongInt> &QGhostVtx,
+			   vector<MilanLongInt> &QMsgType,
+			   vector<MilanInt> &QOwner,
+			   vector<MPI_Request> &SRequest,
+			   vector<MPI_Status> &SStatus);
+  
+  void processMessagesD(
+		       MilanLongInt NLVer,
+		       MilanLongInt *Mate,
+		       MilanLongInt *candidateMate,
+		       map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+		       vector<MilanLongInt> &GMate,
+		       vector<MilanLongInt> &Counter,
+		       MilanLongInt StartIndex,
+		       MilanLongInt EndIndex,
+		       MilanLongInt *myCardPtr,
+		       MilanLongInt *msgIndPtr,
+		       MilanLongInt *msgActualPtr,
+		       MilanReal *edgeLocWeight,
+		       MilanLongInt *verDistance,
+		       MilanLongInt *verLocPtr,
+		       MilanLongInt k,
+		       MilanLongInt *verLocInd,
+		       MilanInt numProcs,
+		       MilanInt myRank,
+		       MPI_Comm comm,
+		       vector<MilanLongInt> &Message,
+		       MilanLongInt numGhostEdges,
+		       MilanLongInt u,
+		       MilanLongInt v,
+		       MilanLongInt *SPtr,
+		       vector<MilanLongInt> &U);
+  
+  void extractUChunk(
+		     vector<MilanLongInt> &UChunkBeingProcessed,
+		     vector<MilanLongInt> &U,
+		     vector<MilanLongInt> &privateU);
 
-void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
-		MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight,
-		MilanLongInt* verDistance,
-		MilanLongInt* Mate,
-		MilanInt myRank, MilanInt numProcs, MilanInt icomm,
-		MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
-		MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
-		MilanLongInt* ph1_card, MilanLongInt* ph2_card );
+  MilanLongInt firstComputeCandidateMateS(MilanLongInt adj1,
+					 MilanLongInt adj2,
+					 MilanLongInt *verLocInd,
+					  MilanFloat *edgeLocWeight);
 
-void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
-		MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight,
-		MilanLongInt* verDistance,
-		MilanLongInt* Mate,
-		MilanInt myRank, MilanInt numProcs, MilanInt icomm,
-		MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
-		MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
-		MilanLongInt* ph1_card, MilanLongInt* ph2_card );
+  MilanLongInt computeCandidateMateS(MilanLongInt adj1,
+				    MilanLongInt adj2,
+				    MilanFloat *edgeLocWeight,
+				    MilanLongInt k,
+				    MilanLongInt *verLocInd,
+				    MilanLongInt StartIndex,
+				    MilanLongInt EndIndex,
+				    vector<MilanLongInt> &GMate,
+				    MilanLongInt *Mate,
+				    map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
+  
+  void PARALLEL_COMPUTE_CANDIDATE_MATE_BS(MilanLongInt NLVer,
+					 MilanLongInt *verLocPtr,
+					 MilanLongInt *verLocInd,
+					 MilanInt myRank,
+					 MilanFloat *edgeLocWeight,
+					 MilanLongInt *candidateMate);
+  
+  void PARALLEL_PROCESS_EXPOSED_VERTEX_BS(MilanLongInt NLVer,
+					 MilanLongInt *candidateMate,
+					 MilanLongInt *verLocInd,
+					 MilanLongInt *verLocPtr,
+					 MilanLongInt StartIndex,
+					 MilanLongInt EndIndex,
+					 MilanLongInt *Mate,
+					 vector<MilanLongInt> &GMate,
+					 map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+					 MilanFloat *edgeLocWeight,
+					 MilanLongInt *myCardPtr,
+					 MilanLongInt *msgIndPtr,
+					 MilanLongInt *NumMessagesBundledPtr,
+					 MilanLongInt *SPtr,
+					 MilanLongInt *verDistance,
+					 MilanLongInt *PCounter,
+					 vector<MilanLongInt> &Counter,
+					 MilanInt myRank,
+					 MilanInt numProcs,
+					 vector<MilanLongInt> &U,
+					 vector<MilanLongInt> &privateU,
+					 vector<MilanLongInt> &QLocalVtx,
+					 vector<MilanLongInt> &QGhostVtx,
+					 vector<MilanLongInt> &QMsgType,
+					 vector<MilanInt> &QOwner,
+					 vector<MilanLongInt> &privateQLocalVtx,
+					 vector<MilanLongInt> &privateQGhostVtx,
+					 vector<MilanLongInt> &privateQMsgType,
+					 vector<MilanInt> &privateQOwner);
+  void processMatchedVerticesS(
+			      MilanLongInt NLVer,
+			      vector<MilanLongInt> &UChunkBeingProcessed,
+			      vector<MilanLongInt> &U,
+			      vector<MilanLongInt> &privateU,
+			      MilanLongInt StartIndex,
+			      MilanLongInt EndIndex,
+			      MilanLongInt *myCardPtr,
+			      MilanLongInt *msgIndPtr,
+			      MilanLongInt *NumMessagesBundledPtr,
+			      MilanLongInt *SPtr,
+			      MilanLongInt *verLocPtr,
+			      MilanLongInt *verLocInd,
+			      MilanLongInt *verDistance,
+			      MilanLongInt *PCounter,
+			      vector<MilanLongInt> &Counter,
+			      MilanInt myRank,
+			      MilanInt numProcs,
+			      MilanLongInt *candidateMate,
+			      vector<MilanLongInt> &GMate,
+			      MilanLongInt *Mate,
+			      map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+			      MilanFloat *edgeLocWeight,
+			      vector<MilanLongInt> &QLocalVtx,
+			      vector<MilanLongInt> &QGhostVtx,
+			      vector<MilanLongInt> &QMsgType,
+			      vector<MilanInt> &QOwner,
+			      vector<MilanLongInt> &privateQLocalVtx,
+			      vector<MilanLongInt> &privateQGhostVtx,
+			      vector<MilanLongInt> &privateQMsgType,
+			      vector<MilanInt> &privateQOwner);
+  
+  void processMatchedVerticesAndSendMessagesS(
+					     MilanLongInt NLVer,
+					     vector<MilanLongInt> &UChunkBeingProcessed,
+					     vector<MilanLongInt> &U,
+					     vector<MilanLongInt> &privateU,
+					     MilanLongInt StartIndex,
+					     MilanLongInt EndIndex,
+					     MilanLongInt *myCardPtr,
+					     MilanLongInt *msgIndPtr,
+					     MilanLongInt *NumMessagesBundledPtr,
+					     MilanLongInt *SPtr,
+					     MilanLongInt *verLocPtr,
+					     MilanLongInt *verLocInd,
+					     MilanLongInt *verDistance,
+					     MilanLongInt *PCounter,
+					     vector<MilanLongInt> &Counter,
+					     MilanInt myRank,
+					     MilanInt numProcs,
+					     MilanLongInt *candidateMate,
+					     vector<MilanLongInt> &GMate,
+					     MilanLongInt *Mate,
+					     map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+					     MilanFloat *edgeLocWeight,
+					     vector<MilanLongInt> &QLocalVtx,
+					     vector<MilanLongInt> &QGhostVtx,
+					     vector<MilanLongInt> &QMsgType,
+					     vector<MilanInt> &QOwner,
+					     vector<MilanLongInt> &privateQLocalVtx,
+					     vector<MilanLongInt> &privateQGhostVtx,
+					     vector<MilanLongInt> &privateQMsgType,
+					     vector<MilanInt> &privateQOwner,
+					     MPI_Comm comm,
+					     MilanLongInt *msgActual,
+					     vector<MilanLongInt> &Message);
+  
+  void processMessagesS(
+		       MilanLongInt NLVer,
+		       MilanLongInt *Mate,
+		       MilanLongInt *candidateMate,
+		       map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+		       vector<MilanLongInt> &GMate,
+		       vector<MilanLongInt> &Counter,
+		       MilanLongInt StartIndex,
+		       MilanLongInt EndIndex,
+		       MilanLongInt *myCardPtr,
+		       MilanLongInt *msgIndPtr,
+		       MilanLongInt *msgActualPtr,
+		       MilanFloat *edgeLocWeight,
+		       MilanLongInt *verDistance,
+		       MilanLongInt *verLocPtr,
+		       MilanLongInt k,
+		       MilanLongInt *verLocInd,
+		       MilanInt numProcs,
+		       MilanInt myRank,
+		       MPI_Comm comm,
+		       vector<MilanLongInt> &Message,
+		       MilanLongInt numGhostEdges,
+		       MilanLongInt u,
+		       MilanLongInt v,
+		       MilanLongInt *SPtr,
+		       vector<MilanLongInt> &U);
+  
+  
+  void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
+			 MilanLongInt NLVer, MilanLongInt NLEdge,
+			 MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
+			 MilanLongInt *verDistance,
+			 MilanLongInt *Mate,
+			 MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
+			 MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
+			 MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
+			 MilanLongInt *ph1_card, MilanLongInt *ph2_card);
+
+  
+  void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
+			 MilanLongInt NLVer, MilanLongInt NLEdge,
+			 MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanFloat *edgeLocWeight,
+			 MilanLongInt *verDistance,
+			 MilanLongInt *Mate,
+			 MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
+			 MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
+			 MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
+			 MilanLongInt *ph1_card, MilanLongInt *ph2_card);
+
+
+
+    void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
+        MilanLongInt NLVer, MilanLongInt NLEdge,
+        MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
+        MilanLongInt *verDistance,
+        MilanLongInt *Mate,
+        MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
+        MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
+        MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
+        MilanLongInt *ph1_card, MilanLongInt *ph2_card);
+
+    void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
+        MilanLongInt NLVer, MilanLongInt NLEdge,
+        MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanFloat *edgeLocWeight,
+        MilanLongInt *verDistance,
+        MilanLongInt *Mate,
+        MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
+        MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
+        MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
+        MilanLongInt *ph1_card, MilanLongInt *ph2_card);
+
+    void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
+                     MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
+                     MilanLongInt *verDistance,
+                     MilanLongInt *Mate,
+                     MilanInt myRank, MilanInt numProcs, MilanInt icomm,
+                     MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
+                     MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
+                     MilanLongInt *ph1_card, MilanLongInt *ph2_card);
+
+    void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
+                     MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanFloat *edgeLocWeight,
+                     MilanLongInt *verDistance,
+                     MilanLongInt *Mate,
+                     MilanInt myRank, MilanInt numProcs, MilanInt icomm,
+                     MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
+                     MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
+                     MilanLongInt *ph1_card, MilanLongInt *ph2_card);
 
 #endif
 #ifdef __cplusplus

amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.cpp

@@ -72,12 +72,6 @@
 
 #ifdef SERIAL_MPI
 #else
-//MPI type map
-template<typename T> MPI_Datatype TypeMap();
-template<> inline MPI_Datatype TypeMap<int64_t>() { return MPI_LONG_LONG; }
-template<> inline MPI_Datatype TypeMap<int>() { return MPI_INT; }
-template<> inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
-template<> inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
 
 // DOUBLE PRECISION VERSION
 //WARNING: The vertex block on a given rank is contiguous
@@ -1309,16 +1303,16 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
 // SINGLE PRECISION VERSION
 
 void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
-                                                              MilanLongInt NLVer, MilanLongInt NLEdge,
-                                                              MilanLongInt* verLocPtr, MilanLongInt* verLocInd,
-							      MilanFloat* edgeLocWeight,
-                                                              MilanLongInt* verDistance,
-                                                              MilanLongInt* Mate,
-                                                              MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
-                                                              MilanLongInt* msgIndSent, MilanLongInt* msgActualSent,
-							      MilanReal* msgPercent,
-                                                              MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
-                                                              MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
+      MilanLongInt NLVer, MilanLongInt NLEdge,
+      MilanLongInt* verLocPtr, MilanLongInt* verLocInd,
+      MilanFloat* edgeLocWeight,
+      MilanLongInt* verDistance,
+      MilanLongInt* Mate,
+      MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
+      MilanLongInt* msgIndSent, MilanLongInt* msgActualSent,
+      MilanReal* msgPercent,
+      MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
+      MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
 #if !defined(SERIAL_MPI)
 #ifdef PRINT_DEBUG_INFO_
     cout<<"\n("<<myRank<<")Within algoEdgeApproxDominatingEdgesLinearSearchMessageBundling()"; fflush(stdout);

amgprec/impl/aggregator/amg_c_dec_aggregator_mat_bld.f90

@@ -177,23 +177,24 @@ subroutine  amg_c_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   select case (parms%aggr_prol)
   case (amg_no_smooth_) 
 
-    call amg_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,&
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_caggrmat_nosmth_bld(parms%aggr_prol,a,desc_a,ilaggr,&
+            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
-  case(amg_smooth_prol_) 
+  case(amg_smooth_prol_,amg_l1_smooth_prol_) 
 
-    call amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr, &
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_caggrmat_smth_bld(parms%aggr_prol,a,desc_a,&
+            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,&
+            op_restr,t_prol,info)
 
 !!$  case(amg_biz_prol_) 
 !!$
 !!$    call amg_caggrmat_biz_bld(a,desc_a,ilaggr,nlaggr, &
 !!$         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
-
+  
   case(amg_min_energy_) 
 
-    call amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, &
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_caggrmat_minnrg_bld(parms%aggr_prol,a,desc_a,ilaggr,&
+            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
   case default
     info = psb_err_internal_error_

amgprec/impl/aggregator/amg_c_dec_aggregator_tprol.f90

@@ -97,6 +97,8 @@ subroutine  amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
   integer(psb_lpk_)   :: ntaggr
   integer(psb_ipk_)   :: debug_level, debug_unit
   logical             :: clean_zeros
+  integer(psb_ipk_), save :: idx_map_bld=-1, idx_map_tprol=-1
+  logical, parameter      :: do_timings=.false.
 
   name='amg_c_dec_aggregator_tprol'
   call psb_erractionsave(err_act)
@@ -108,6 +110,10 @@ subroutine  amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
+  if ((do_timings).and.(idx_map_bld==-1))       &
+       & idx_map_bld = psb_get_timer_idx("DEC_TPROL: map_bld")
+  if ((do_timings).and.(idx_map_tprol==-1))     &
+       & idx_map_tprol = psb_get_timer_idx("DEC_TPROL: map_tprol")
 
   call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
        &   amg_mult_ml_,is_legal_ml_cycle)
@@ -121,10 +127,14 @@ subroutine  amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
   ! The decoupled aggregator based on SOC measures ignores
   ! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
   !
+  if (do_timings) call psb_tic(idx_map_bld)
   clean_zeros = ag%do_clean_zeros
   call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
+  if (do_timings) call psb_toc(idx_map_bld)
+  if (do_timings) call psb_tic(idx_map_tprol)
 
   if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
+  if (do_timings) call psb_toc(idx_map_tprol)
   if (info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

amgprec/impl/aggregator/amg_c_ptap_bld.f90

@@ -76,7 +76,7 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   integer(psb_ipk_) :: nrow, ncol, nrl, nzl, ip, nzt, i, k
   integer(psb_lpk_) ::  nrsave, ncsave, nzsave, nza
   logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.  
-  integer(psb_ipk_), save :: idx_spspmm=-1
+  integer(psb_ipk_), save :: idx_spspmm=-1, idx_cpytrans1=-1, idx_cpytrans2=-1
 
   name='amg_ptap_bld'
   if(psb_get_errstatus().ne.0) return 
@@ -93,7 +93,11 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ncol  = desc_a%get_local_cols()
 
   if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("SPMM_BLD: par_spspmm")
+       & idx_spspmm = psb_get_timer_idx("PTAP_BLD: par_spspmm")
+  if ((do_timings).and.(idx_cpytrans1==-1)) &
+       & idx_cpytrans1 = psb_get_timer_idx("PTAP_BLD: cpy&trans1")
+  if ((do_timings).and.(idx_cpytrans2==-1)) &
+       & idx_cpytrans2 = psb_get_timer_idx("PTAP_BLD: cpy&trans2")
 
   naggr   = nlaggr(me+1)
   ntaggr  = sum(nlaggr)
@@ -128,6 +132,7 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ! Ok first product done.
 
   if (present(desc_ax)) then
+    if (do_timings) call psb_tic(idx_cpytrans1)
     block 
       call coo_prol%cp_to_coo(coo_restr,info)
       call coo_restr%set_ncols(desc_ac%get_local_cols())
@@ -137,7 +142,7 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
       call coo_restr%set_ncols(desc_ax%get_local_cols())
     end block
     call csr_restr%cp_from_coo(coo_restr,info)
-
+    if (do_timings) call psb_toc(idx_cpytrans1)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999
@@ -167,27 +172,28 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
     call coo_restr%transp()
     nzl = coo_restr%get_nzeros()
-    nrl = desc_ac%get_local_rows() 
-    i=0
+    nrl = desc_ac%get_local_rows()
+    call coo_restr%fix(info)
+    i=coo_restr%get_nzeros()
     !
     ! Only keep local rows
     !
-    do k=1, nzl
-      if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then
-        i = i+1
-        coo_restr%val(i) = coo_restr%val(k)
-        coo_restr%ia(i)  = coo_restr%ia(k)
-        coo_restr%ja(i)  = coo_restr%ja(k)
+    search: do k=i,1,-1
+      if (coo_restr%ia(k) <= nrl) then
+        call coo_restr%set_nzeros(k)
+        exit search
       end if
-    end do
-    call coo_restr%set_nzeros(i)
-    call coo_restr%fix(info) 
+    end do search
+
     nzl  = coo_restr%get_nzeros()
     call coo_restr%set_nrows(desc_ac%get_local_rows())
     call coo_restr%set_ncols(desc_a%get_local_cols())
     if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
+    if (do_timings) call psb_tic(idx_cpytrans2)
+        
     call csr_restr%cp_from_coo(coo_restr,info)
 
+    if (do_timings) call psb_toc(idx_cpytrans2)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999
@@ -210,6 +216,7 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
   call ac_csr%set_nrows(desc_ac%get_local_rows())
   call ac_csr%set_ncols(desc_ac%get_local_cols())
+  call ac_csr%clean_zeros(info)
   call ac%mv_from(ac_csr)
   call ac%set_asb()
 
@@ -414,6 +421,7 @@ subroutine amg_c_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
   call ac_csr%set_nrows(desc_ac%get_local_rows())
   call ac_csr%set_ncols(desc_ac%get_local_cols())
+  call ac_csr%clean_zeros(info)
   call ac%mv_from(ac_csr)
   call ac%set_asb()
 
@@ -623,6 +631,7 @@ subroutine amg_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
   call ac_csr%set_nrows(desc_ac%get_local_rows())
   call ac_csr%set_ncols(desc_ac%get_local_cols())
+  call ac_csr%clean_zeros(info)
   call ac%mv_from(ac_csr)
   call ac%set_asb()
 

amgprec/impl/aggregator/amg_c_rap.f90

@@ -142,6 +142,7 @@ subroutine amg_c_rap(a_csr,desc_a,nlaggr,parms,ac,&
 
   call ac_csr%set_nrows(desc_ac%get_local_rows())
   call ac_csr%set_ncols(desc_ac%get_local_cols())
+  call ac_csr%clean_zeros(info)
   call ac%mv_from(ac_csr)
   call ac%set_asb()
 

amgprec/impl/aggregator/amg_c_soc1_map_bld.F90

@@ -72,7 +72,9 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   use psb_base_mod
   use amg_base_prec_type
   use amg_c_inner_mod
-
+#if defined(OPENMP)
+  use omp_lib
+#endif
   implicit none
 
   ! Arguments
@@ -85,7 +87,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_), intent(out)               :: info
 
   ! Local variables
-  integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:),&
+  integer(psb_ipk_), allocatable :: neigh(:), irow(:), icol(:),&
        & ideg(:), idxs(:)
   integer(psb_lpk_), allocatable :: tmpaggr(:)
   complex(psb_spk_), allocatable  :: val(:), diag(:)
@@ -99,6 +101,9 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_)   :: nrow, ncol, n_ne
   integer(psb_lpk_)   :: nrglob
   character(len=20)   :: name, ch_err
+  integer(psb_ipk_), save :: idx_soc1_p1=-1, idx_soc1_p2=-1, idx_soc1_p3=-1
+  integer(psb_ipk_), save :: idx_soc1_p0=-1
+  logical, parameter      :: do_timings=.true.
 
   info=psb_success_
   name = 'amg_soc1_map_bld'
@@ -114,6 +119,14 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nrow   = desc_a%get_local_rows()
   ncol   = desc_a%get_local_cols()
   nrglob = desc_a%get_global_rows()
+  if ((do_timings).and.(idx_soc1_p0==-1))       &
+       & idx_soc1_p0 = psb_get_timer_idx("SOC1_MAP: phase0")
+  if ((do_timings).and.(idx_soc1_p1==-1))       &
+       & idx_soc1_p1 = psb_get_timer_idx("SOC1_MAP: phase1")
+  if ((do_timings).and.(idx_soc1_p2==-1))       &
+       & idx_soc1_p2 = psb_get_timer_idx("SOC1_MAP: phase2")
+  if ((do_timings).and.(idx_soc1_p3==-1))       &
+       & idx_soc1_p3 = psb_get_timer_idx("SOC1_MAP: phase3")
 
   nr = a%get_nrows()
   nc = a%get_ncols()
@@ -133,41 +146,205 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
     goto 9999
   end if
 
+  if (do_timings) call psb_tic(idx_soc1_p0)
   call a%cp_to(acsr)
+  if (do_timings) call psb_toc(idx_soc1_p0)
   if (clean_zeros) call acsr%clean_zeros(info)
   if (iorder == amg_aggr_ord_nat_) then 
+    !$omp parallel do private(i) schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
-      idxs(i)   = i 
+      idxs(i)   = i
     end do
-  else 
+    !$omp end parallel do 
+  else
+    !$omp parallel do private(i) schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
       ideg(i)   = acsr%irp(i+1) - acsr%irp(i)
     end do
+    !$omp end parallel do 
     call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
   end if
-
+  if (do_timings) call psb_tic(idx_soc1_p1)
 
   !
   ! Phase one: Start with disjoint groups.
   ! 
   naggr = 0
-  icnt = 0
+#if defined(OPENMP)
+  block
+    integer(psb_ipk_), allocatable  :: bnds(:), locnaggr(:)
+    integer(psb_ipk_) :: myth,nths, kk
+    ! The parallelization makes use of a locaggr(:) array; each thread
+    ! keeps its own version of naggr, and when the loop ends, a prefix is applied
+    ! to locnaggr to determine:
+    ! 1. The total number of aggregaters NAGGR;
+    ! 2. How much should each thread shift its own aggregates
+    ! Part 2 requires to keep track of which thread defined each entry
+    ! of ilaggr(), so that each entry can be adjusted correctly: even
+    ! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
+    ! been set because it is strongly connected to an entry J belonging to a
+    ! different thread. 
+
+    !$omp parallel shared(bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
+    !$omp private(icol,val,myth,kk) 
+    block
+      integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz, nc, i,j,m, nz, ilg,  ip, rsz
+      integer(psb_lpk_) :: itmp
+      !$omp master
+      nths = omp_get_num_threads()
+      allocate(bnds(0:nths),locnaggr(0:nths+1))
+      locnaggr(:) = 0
+      bnds(0) = 1
+      !$omp end master      
+      !$omp barrier
+      myth = omp_get_thread_num()
+      rsz = nr/nths
+      if (myth < mod(nr,nths)) rsz = rsz + 1
+      bnds(myth+1) = rsz
+      !$omp barrier
+      !$omp master
+      do i=1,nths
+        bnds(i) = bnds(i) + bnds(i-1)
+      end do
+      info = 0
+      !$omp end master
+      !$omp barrier
+      
+      !$omp do schedule(static) private(disjoint) 
+      do kk=0, nths-1
+        step1: do ii=bnds(kk), bnds(kk+1)-1
+          i = idxs(ii)          
+          if (info /= 0) cycle step1
+          if ((i<1).or.(i>nr)) then
+            !$omp atomic write
+            info=psb_err_internal_error_
+            !$omp end atomic 
+            call psb_errpush(info,name)
+            cycle step1
+            !goto 9999
+          end if
+            
+          if (ilaggr(i) == -(nr+1)) then
+            nz         = (acsr%irp(i+1)-acsr%irp(i))
+            if ((nz<0).or.(nz>size(icol))) then
+              !$omp atomic write
+              info=psb_err_internal_error_
+              !$omp end atomic 
+              call psb_errpush(info,name)
+              cycle step1
+              !goto 9999
+            end if
+
+            icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
+            val(1:nz)  = acsr%val(acsr%irp(i):acsr%irp(i+1)-1) 
+
+            !
+            ! Build the set of all strongly coupled nodes 
+            !
+            ip = 0
+            do k=1, nz
+              j   = icol(k)
+              ! If any of the neighbours is already assigned,
+              ! we will not reset. 
+              if (j>nr) cycle step1
+              if (ilaggr(j) > 0) cycle step1
+              if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.czero)) then
+                ip = ip + 1
+                icol(ip) = icol(k)
+              end if
+            enddo
+            
+            !
+            ! If the whole strongly coupled neighborhood of I is
+            ! as yet unconnected, turn it into the next aggregate.
+            ! Same if ip==0 (in which case, neighborhood only
+            ! contains I even if it does not look like it from matrix)
+            ! The fact that DISJOINT is private and not under lock
+            ! generates a certain un-repeatability, in that between
+            ! computing DISJOINT and assigning, another thread might
+            ! alter the values of ILAGGR.
+            ! However, a certain unrepeatability is already present
+            ! because the sequence of aggregates is computed with a
+            ! different order than in serial mode.
+            ! In any case, even if the enteries of ILAGGR may be
+            ! overwritten, the important thing is that each entry is
+            ! consistent and they generate a correct aggregation map.
+            !
+            disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
+            if (disjoint) then
+              locnaggr(kk)     = locnaggr(kk) + 1
+              itmp = (bnds(kk)-1+locnaggr(kk)) !be careful about overflow
+              itmp = itmp*nths+kk
+              if (itmp < (bnds(kk)-1+locnaggr(kk))) then
+                !$omp atomic update
+                info = max(12345678,info)
+                !$omp end atomic
+                cycle step1
+              end if
+              !$omp atomic write
+              ilaggr(i) = itmp
+              !$omp end atomic
+              do k=1, ip
+                !$omp atomic write
+                ilaggr(icol(k)) = itmp
+                !$omp end atomic
+              end do
+            end if
+          end if
+        enddo step1
+      end do
+      !$omp end do
+
+      !$omp master
+      naggr = sum(locnaggr(0:nths-1))
+      do i=1,nths
+        locnaggr(i) = locnaggr(i) + locnaggr(i-1)
+      end do
+      do i=nths+1,1,-1
+        locnaggr(i) = locnaggr(i-1)
+      end do
+      locnaggr(0) = 0
+      !$omp end master 
+      !$omp barrier
+      !$omp  do schedule(static) 
+      do kk=0, nths-1
+        do ii=bnds(kk), bnds(kk+1)-1
+          if (ilaggr(ii) > 0) then 
+            kp = mod(ilaggr(ii),nths)
+            ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
+          end if
+        end do
+      end do
+      !$omp end do
+    end block
+    !$omp end parallel
+  end block
+  if (info /= 0) then
+    if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
+    info=psb_err_internal_error_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+#else
   step1: do ii=1, nr
+    if (info /= 0) cycle
     i = idxs(ii)
     if ((i<1).or.(i>nr)) then
       info=psb_err_internal_error_
       call psb_errpush(info,name)
-      goto 9999
+      cycle step1
+      !goto 9999
     end if
-    
+
     if (ilaggr(i) == -(nr+1)) then
       nz         = (acsr%irp(i+1)-acsr%irp(i))
       if ((nz<0).or.(nz>size(icol))) then
         info=psb_err_internal_error_
         call psb_errpush(info,name)
-        goto 9999
+        cycle step1
+        !goto 9999
       end if
 
       icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
@@ -176,11 +353,11 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       !
       ! Build the set of all strongly coupled nodes 
       !
-      ip = 0 
+      ip = 0
       do k=1, nz
         j   = icol(k)
         if ((1<=j).and.(j<=nr)) then 
-          if (abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))) then
+          if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.czero)) then
             ip = ip + 1
             icol(ip) = icol(k)
           end if
@@ -194,8 +371,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       ! contains I even if it does not look like it from matrix)
       !
       disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
-      if (disjoint) then 
-        icnt      = icnt + 1 
+      if (disjoint) then       
         naggr     = naggr + 1
         do k=1, ip
           ilaggr(icol(k)) = naggr
@@ -204,16 +380,22 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     endif
   enddo step1
-  
+#endif
   if (debug_level >= psb_debug_outer_) then 
     write(debug_unit,*) me,' ',trim(name),&
-         & ' Check 1:',count(ilaggr == -(nr+1))
+         & ' Check   1:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
+         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
   end if
-
+  if (do_timings) call psb_toc(idx_soc1_p1)
+  if (do_timings) call psb_tic(idx_soc1_p2)
   !
   ! Phase two: join the neighbours
   !
+  !$omp workshare
   tmpaggr = ilaggr
+  !$omp end workshare
+  !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,theta)& 
+  !$omp     private(ii,i,j,k,nz,icol,val,ip,cpling)
   step2: do ii=1,nr
     i = idxs(ii)
 
@@ -244,8 +426,15 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     end if
   end do step2
+  !$omp end parallel do
+  if (do_timings) call psb_toc(idx_soc1_p2)
+  if (debug_level >= psb_debug_outer_) then 
+    write(debug_unit,*) me,' ',trim(name),&
+         & ' Check 1.5:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
+         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
+  end if
 
-
+  if (do_timings) call psb_tic(idx_soc1_p3)
   !
   ! Phase three: sweep over leftovers, if any 
   !
@@ -274,7 +463,6 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         end if
       enddo
       if (ip > 0) then
-        icnt      = icnt + 1 
         naggr     = naggr + 1
         ilaggr(i) = naggr
         do k=1, ip
@@ -292,7 +480,10 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   end do step3
 
   ! Any leftovers?
+  !$omp parallel do schedule(static) shared(ilaggr,info)& 
+  !$omp     private(ii,i,j,k,nz,icol,val,ip)
   do i=1, nr
+    if (info /= 0) cycle
     if (ilaggr(i) < 0) then
       nz = (acsr%irp(i+1)-acsr%irp(i))
       if (nz == 1) then
@@ -303,15 +494,18 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         ! other processes. 
         ilaggr(i) = -(nrglob+nr)
       else
+        !$omp atomic write
         info=psb_err_internal_error_
+        !$omp end atomic
         call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
-        goto 9999
+        cycle 
       endif
     end if
   end do
-
+  !$omp end parallel do
+  if (info /= 0) goto 9999
+  if (do_timings) call psb_toc(idx_soc1_p3)
   if (naggr > ncol) then 
-    !write(0,*) name,'Error : naggr > ncol',naggr,ncol
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')
     goto 9999
@@ -336,9 +530,13 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nlaggr(:) = 0
   nlaggr(me+1) = naggr
   call psb_sum(ctxt,nlaggr(1:np))
+  if (debug_level >= psb_debug_outer_) then 
+    write(debug_unit,*) me,' ',trim(name),&
+         & ' Check   2:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
+         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
+  end if
 
   call acsr%free()
-
   call psb_erractionrestore(err_act)
   return
 
@@ -347,4 +545,3 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   return
 
 end subroutine amg_c_soc1_map_bld
-

amgprec/impl/aggregator/amg_c_soc2_map_bld.F90

@@ -68,9 +68,12 @@
 !
 subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
 
-  use psb_base_mod
+  use psb_base_mod 
   use amg_base_prec_type
   use amg_c_inner_mod
+#if defined(OPENMP)
+  use omp_lib
+#endif
 
   implicit none
 
@@ -99,6 +102,9 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_) :: np, me
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
+  integer(psb_ipk_), save :: idx_soc2_p1=-1, idx_soc2_p2=-1, idx_soc2_p3=-1
+  integer(psb_ipk_), save :: idx_soc2_p0=-1
+  logical, parameter      :: do_timings=.true.
 
   info=psb_success_
   name = 'amg_soc2_map_bld'
@@ -114,6 +120,14 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nrow   = desc_a%get_local_rows()
   ncol   = desc_a%get_local_cols()
   nrglob = desc_a%get_global_rows()
+  if ((do_timings).and.(idx_soc2_p0==-1))       &
+       & idx_soc2_p0 = psb_get_timer_idx("SOC2_MAP: phase0")
+  if ((do_timings).and.(idx_soc2_p1==-1))       &
+       & idx_soc2_p1 = psb_get_timer_idx("SOC2_MAP: phase1")
+  if ((do_timings).and.(idx_soc2_p2==-1))       &
+       & idx_soc2_p2 = psb_get_timer_idx("SOC2_MAP: phase2")
+  if ((do_timings).and.(idx_soc2_p3==-1))       &
+       & idx_soc2_p3 = psb_get_timer_idx("SOC2_MAP: phase3")
 
   nr = a%get_nrows()
   nc = a%get_ncols()
@@ -125,6 +139,7 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
     goto 9999
   end if
 
+  if (do_timings) call psb_tic(idx_soc2_p0)
   diag = a%get_diag(info)
   if(info /= psb_success_) then
     info=psb_err_from_subroutine_
@@ -137,55 +152,218 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   ! 
   call a%cp_to(muij)
   if (clean_zeros) call muij%clean_zeros(info)
+  !$omp parallel do private(i,j,k) shared(nr,diag,muij) schedule(static)
   do i=1, nr
     do k=muij%irp(i),muij%irp(i+1)-1
       j = muij%ja(k)
       if (j<= nr) muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
     end do
   end do
-
+  !$omp end parallel do 
   !
   ! Compute the 1-neigbour; mark strong links with +1, weak links with -1
   !
   call s_neigh_coo%allocate(nr,nr,muij%get_nzeros())
-  ip = 0 
+  !$omp parallel do private(i,j,k) shared(nr,diag,muij) schedule(static)
   do i=1, nr
     do k=muij%irp(i),muij%irp(i+1)-1
       j = muij%ja(k)
+      s_neigh_coo%ia(k)  = i
+      s_neigh_coo%ja(k)  = j
       if (j<=nr) then 
-        ip = ip + 1
-        s_neigh_coo%ia(ip)  = i
-        s_neigh_coo%ja(ip)  = j
         if (real(muij%val(k)) >= theta) then 
-          s_neigh_coo%val(ip) = sone
+          s_neigh_coo%val(k) = sone
         else
-          s_neigh_coo%val(ip) = -sone
+          s_neigh_coo%val(k) = -sone
         end if
+      else
+        s_neigh_coo%val(k) = -sone        
       end if
     end do
   end do
+  !$omp end parallel do
   !write(*,*) 'S_NEIGH: ',nr,ip
-  call s_neigh_coo%set_nzeros(ip)
+  call s_neigh_coo%set_nzeros(muij%get_nzeros())
   call s_neigh%mv_from_coo(s_neigh_coo,info)
 
-  if (iorder == amg_aggr_ord_nat_) then 
+  if (iorder == amg_aggr_ord_nat_) then
+    
+    !$omp parallel do private(i) shared(ilaggr,idxs) schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
       idxs(i)   = i 
     end do
+    !$omp end parallel do 
   else 
+    !$omp parallel do private(i) shared(ilaggr,idxs,muij)  schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
       ideg(i)   = muij%irp(i+1) - muij%irp(i)
     end do
+    !$omp end parallel do
     call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
   end if
 
+  if (do_timings) call psb_toc(idx_soc2_p0)
+  if (do_timings) call psb_tic(idx_soc2_p1)
 
   !
   ! Phase one: Start with disjoint groups.
   ! 
   naggr = 0
+#if defined(OPENMP)
+  block
+    integer(psb_ipk_), allocatable  :: bnds(:), locnaggr(:)
+    integer(psb_ipk_) :: myth,nths, kk
+    ! The parallelization makes use of a locaggr(:) array; each thread
+    ! keeps its own version of naggr, and when the loop ends, a prefix is applied
+    ! to locnaggr to determine:
+    ! 1. The total number of aggregaters NAGGR;
+    ! 2. How much should each thread shift its own aggregates
+    ! Part 2 requires to keep track of which thread defined each entry
+    ! of ilaggr(), so that each entry can be adjusted correctly: even
+    ! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
+    ! been set because it is strongly connected to an entry J belonging to a
+    ! different thread. 
+
+    !$omp parallel shared(s_neigh,bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
+    !$omp private(icol,val,myth,kk) 
+    block
+      integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz,nc,i,j,m,nz,ilg,ip,rsz,ip1,nzcnt
+      integer(psb_lpk_) :: itmp
+      !$omp master
+      nths = omp_get_num_threads()
+      allocate(bnds(0:nths),locnaggr(0:nths+1))
+      locnaggr(:) = 0
+      bnds(0) = 1
+      !$omp end master      
+      !$omp barrier
+      myth = omp_get_thread_num()
+      rsz = nr/nths
+      if (myth < mod(nr,nths)) rsz = rsz + 1
+      bnds(myth+1) = rsz
+      !$omp barrier
+      !$omp master
+      do i=1,nths
+        bnds(i) = bnds(i) + bnds(i-1)
+      end do
+      info = 0
+      !$omp end master
+      !$omp barrier
+
+      !$omp do schedule(static) private(disjoint) 
+      do kk=0, nths-1
+        step1: do ii=bnds(kk), bnds(kk+1)-1
+          i = idxs(ii)
+          if (info /= 0) then
+            write(0,*) ' Step1:',kk,ii,i,info
+            cycle step1
+          end if
+          if ((i<1).or.(i>nr)) then
+            !$omp atomic write
+            info=psb_err_internal_error_
+            !$omp end atomic 
+            call psb_errpush(info,name)
+            cycle step1
+            !goto 9999
+          end if
+
+
+          if (ilaggr(i) == -(nr+1)) then 
+            !
+            ! Get the 1-neighbourhood of I 
+            !
+            ip1 = s_neigh%irp(i)
+            nz  = s_neigh%irp(i+1)-ip1
+            !
+            ! If the neighbourhood only contains I, skip it
+            !
+            if (nz ==0) then
+              ilaggr(i) = 0
+              cycle step1
+            end if
+            if ((nz==1).and.(s_neigh%ja(ip1)==i)) then
+              ilaggr(i) = 0
+              cycle step1
+            end if
+
+            nzcnt = count(real(s_neigh%val(ip1:ip1+nz-1)) > 0)
+            icol(1:nzcnt) = pack(s_neigh%ja(ip1:ip1+nz-1),(real(s_neigh%val(ip1:ip1+nz-1)) > 0))
+            disjoint = all(ilaggr(icol(1:nzcnt)) == -(nr+1)) 
+
+            !
+            ! If the whole strongly coupled neighborhood of I is
+            ! as yet unconnected, turn it into the next aggregate.
+            ! Same if ip==0 (in which case, neighborhood only
+            ! contains I even if it does not look like it from matrix)
+            ! The fact that DISJOINT is private and not under lock
+            ! generates a certain un-repeatability, in that between
+            ! computing DISJOINT and assigning, another thread might
+            ! alter the values of ILAGGR.
+            ! However, a certain unrepeatability is already present
+            ! because the sequence of aggregates is computed with a
+            ! different order than in serial mode.
+            ! In any case, even if the enteries of ILAGGR may be
+            ! overwritten, the important thing is that each entry is
+            ! consistent and they generate a correct aggregation map.
+            !
+            if (disjoint) then
+              locnaggr(kk)     = locnaggr(kk) + 1
+              itmp = (bnds(kk)-1+locnaggr(kk)) !be careful about overflow
+              itmp = itmp*nths+kk
+              if (itmp < (bnds(kk)-1+locnaggr(kk))) then
+                !$omp atomic update
+                info = max(12345678,info)
+                !$omp end atomic
+                cycle step1
+              end if
+              !$omp atomic write
+              ilaggr(i) = itmp
+              !$omp end atomic
+              do k=1, nzcnt
+                !$omp atomic write
+                ilaggr(icol(k)) = itmp
+                !$omp end atomic
+              end do
+            end if
+          end if
+        enddo step1
+      end do
+      !$omp end do
+
+      !$omp master
+      naggr = sum(locnaggr(0:nths-1))
+      do i=1,nths
+        locnaggr(i) = locnaggr(i) + locnaggr(i-1)
+      end do
+      do i=nths+1,1,-1
+        locnaggr(i) = locnaggr(i-1)
+      end do
+      locnaggr(0) = 0
+      !write(0,*) 'LNAG ',locnaggr(nths+1)
+      !$omp end master 
+      !$omp barrier
+      !$omp  do schedule(static) 
+      do kk=0, nths-1
+        do ii=bnds(kk), bnds(kk+1)-1
+          if (ilaggr(ii) > 0) then 
+            kp = mod(ilaggr(ii),nths)
+            ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
+          end if
+        end do
+      end do
+      !$omp end do
+    end block
+    !$omp end parallel
+  end block
+  if (info /= 0) then
+    if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
+    info=psb_err_internal_error_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+#else
   icnt = 0
   step1: do ii=1, nr
     i = idxs(ii)
@@ -224,16 +402,21 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     endif
   enddo step1
-  
+#endif  
   if (debug_level >= psb_debug_outer_) then 
     write(debug_unit,*) me,' ',trim(name),&
          & ' Check 1:',count(ilaggr == -(nr+1))
   end if
-
+  if (do_timings) call psb_toc(idx_soc2_p1)
+  if (do_timings) call psb_tic(idx_soc2_p2)
   !
   ! Phase two: join the neighbours
   !
+  !$omp workshare
   tmpaggr = ilaggr
+  !$omp end workshare
+  !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,muij,s_neigh)& 
+  !$omp     private(ii,i,j,k,nz,icol,val,ip,cpling)
   step2: do ii=1,nr
     i = idxs(ii)
 
@@ -259,8 +442,9 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     end if
   end do step2
-
-
+  !$omp end parallel do
+  if (do_timings) call psb_toc(idx_soc2_p2)
+  if (do_timings) call psb_tic(idx_soc2_p3)
   !
   ! Phase three: sweep over leftovers, if any 
   !
@@ -294,6 +478,8 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   end do step3
 
   ! Any leftovers?
+  !$omp parallel do schedule(static) shared(ilaggr,s_neigh,info)& 
+  !$omp     private(ii,i,j,k)
   do i=1, nr
     if (ilaggr(i) <= 0) then
       nz = (s_neigh%irp(i+1)-s_neigh%irp(i))
@@ -305,13 +491,17 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         ! other processes. 
         ilaggr(i) = -(nrglob+nr)
       else
+        !$omp atomic write
         info=psb_err_internal_error_
+        !$omp end atomic
         call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
-        goto 9999
+        cycle
       endif
     end if
   end do
-
+  !$omp end parallel do
+  if (info /= 0) goto 9999
+  if (do_timings) call psb_toc(idx_soc2_p3)  
   if (naggr > ncol) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')

amgprec/impl/aggregator/amg_caggrmat_minnrg_bld.f90

@@ -69,6 +69,7 @@
 !
 !
 ! Arguments:
+!    dol1smoothing - fictitious integer argument, it is not used inside
 !    a          -  type(psb_cspmat_type), input.     
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -104,8 +105,8 @@
 !                  Error code.
 !
 !
-subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_caggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
+                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_c_inner_mod, amg_protect_name => amg_caggrmat_minnrg_bld
@@ -113,6 +114,7 @@ subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
   implicit none
 
   ! Arguments
+  integer(psb_ipk_), intent(in)                 :: dol1smoothing
   type(psb_cspmat_type), intent(in)           :: a
   type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
@@ -171,6 +173,13 @@ subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   filter_mat = (parms%aggr_filter == amg_filter_mat_)
 
+  if (dol1smoothing.ne.amg_no_smooth_) then
+    info=psb_err_fatal_; 
+    call psb_errpush(info,name,a_err='Are you trying to smooth an unsmoothed aggregation?')
+    goto 9999
+  end if
+
+
   !NEEDS TO BE REWORKED !!
   
   ! naggr: number of local aggregates
@@ -300,7 +309,7 @@ subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
 !!$        endif
 !!$      enddo
 !!$      if (jd == -1) then 
-!!$        write(0,*) 'Wrong input: we need the diagonal!!!!', i
+!!$                write(0,*) name,': Warning: there is no diagonal element', i
 !!$      else
 !!$        acsrf%val(jd)=acsrf%val(jd)-tmp
 !!$      end if

amgprec/impl/aggregator/amg_caggrmat_nosmth_bld.f90

@@ -94,10 +94,11 @@
 !               
 !    info       -  integer, output.
 !                  Error code.
+!    dol1smoothing - optional, this is here just for interfacing reasons. It is not used by the
+!                    code
 !
-!
-subroutine amg_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_caggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
+                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_c_inner_mod, amg_protect_name => amg_caggrmat_nosmth_bld
@@ -105,6 +106,7 @@ subroutine amg_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   implicit none
 
   ! Arguments
+  integer(psb_ipk_), intent(in)              :: dol1smoothing 
   type(psb_cspmat_type), intent(in)        :: a
   type(psb_desc_type), intent(inout)         :: desc_a
   integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
@@ -137,6 +139,12 @@ subroutine amg_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   ctxt = desc_a%get_context()
   call psb_info(ctxt, me, np)
+  if (dol1smoothing.ne.amg_no_smooth_) then
+    info=psb_err_fatal_;         
+    call psb_errpush(info,name,a_err='Are you trying to smooth an unsmoothed aggregation?')
+    goto 9999
+  end if
+
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
   ncol  = desc_a%get_local_cols()

amgprec/impl/aggregator/amg_caggrmat_smth_bld.f90

@@ -69,6 +69,8 @@
 !
 !
 ! Arguments:
+!    dol1smooth -  Integer taking the type of smoother that has to be used
+!                  on the tentative prolongator
 !    a          -  type(psb_cspmat_type), input.     
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -102,16 +104,18 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_caggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
+                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_c_inner_mod, amg_protect_name => amg_caggrmat_smth_bld
   use amg_c_base_aggregator_mod
+!  use, intrinsic :: ieee_arithmetic
 
   implicit none
 
   ! Arguments
+  integer(psb_ipk_), intent(in)            :: dol1smoothing
   type(psb_cspmat_type), intent(in)      :: a
   type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
@@ -132,7 +136,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   type(psb_c_coo_sparse_mat) :: coo_prol, coo_restr
   type(psb_c_csr_sparse_mat) :: acsr1,  acsrf, csr_prol, acsr
   complex(psb_spk_), allocatable :: adiag(:)
-  real(psb_spk_), allocatable :: arwsum(:)
+  real(psb_spk_), allocatable :: arwsum(:),l1rwsum(:)
   integer(psb_ipk_)  :: ierr(5)
   logical            :: filter_mat
   integer(psb_ipk_)            :: debug_level, debug_unit, err_act
@@ -140,6 +144,10 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   real(psb_spk_)     :: anorm, omega, tmp, dg, theta
   logical, parameter :: debug_new=.false.
   character(len=80) :: filename
+  logical, parameter :: do_timings=.false.
+  logical :: do_l1correction=.false.
+  integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1
+  integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1
 
   name='amg_aggrmat_smth_bld'
   info=psb_success_
@@ -153,6 +161,26 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   ctxt = desc_a%get_context()
 
   call psb_info(ctxt, me, np)
+  if ((do_timings).and.(idx_spspmm==-1)) &
+       & idx_spspmm = psb_get_timer_idx("DEC_SMTH_BLD: par_spspmm")
+  if ((do_timings).and.(idx_phase1==-1)) &
+       & idx_phase1 = psb_get_timer_idx("DEC_SMTH_BLD: phase1    ")
+  if ((do_timings).and.(idx_phase2==-1)) &
+       & idx_phase2 = psb_get_timer_idx("DEC_SMTH_BLD: phase2    ")
+  if ((do_timings).and.(idx_phase3==-1)) &
+       & idx_phase3 = psb_get_timer_idx("DEC_SMTH_BLD: phase3    ")
+  if ((do_timings).and.(idx_gtrans==-1)) &
+       & idx_gtrans = psb_get_timer_idx("DEC_SMTH_BLD: gtrans    ")
+  if ((do_timings).and.(idx_refine==-1)) &
+       & idx_refine = psb_get_timer_idx("DEC_SMTH_BLD: refine    ")
+  if ((do_timings).and.(idx_cdasb==-1)) &
+       & idx_cdasb = psb_get_timer_idx("DEC_SMTH_BLD: cdasb     ")
+  if ((do_timings).and.(idx_ptap==-1)) &
+       & idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld  ")
+
+  ! check if we have to use Jacobi or l1-Jacobi to smooth the tentative prolongator
+  if (dol1smoothing.eq.amg_l1_smooth_prol_) do_l1correction=.true.
+
 
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
@@ -165,12 +193,13 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   naggrm1 = sum(nlaggr(1:me))
   naggrp1 = sum(nlaggr(1:me+1))
-  filter_mat = (parms%aggr_filter == amg_filter_mat_)
+  filter_mat = (parms%aggr_filter == amg_filter_mat_).or.(parms%aggr_filter == amg_filter_prow_mat_)
 
   !
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
+  if (do_timings) call psb_tic(idx_phase1)
 
   ! Get the diagonal D
   adiag = a%get_diag(info)
@@ -179,6 +208,24 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
   if (info == psb_success_) call a%cp_to(acsr)
+  !
+  ! Do the l1-correction on the diagonal if it is requested
+  !
+  if (do_l1correction) then
+    allocate(l1rwsum(nrow))
+    call acsr%arwsum(l1rwsum)
+    if (info == psb_success_) &
+      & call psb_realloc(ncol,l1rwsum,info)
+    if (info == psb_success_) &
+      & call psb_halo(l1rwsum,desc_a,info)
+    ! \tilde{D}_{i,i} = \sum_{j \ne i} |a_{i,j}|
+    !$OMP parallel do private(i) schedule(static)
+    do i=1,size(adiag)
+        adiag(i) = adiag(i) + l1rwsum(i) - abs(adiag(i))
+    end do
+    !$OMP end parallel do
+  end if
+
 
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
@@ -196,7 +243,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     !
     ! Build the filtered matrix Af from A
     ! 
-
+    !$OMP parallel do private(i,j,tmp,jd) schedule(static)
     do i=1, nrow
       tmp = czero
       jd  = -1 
@@ -209,16 +256,23 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
       enddo
       if (jd == -1) then 
+        ! if (.not.do_l1correction) 
         write(0,*) 'Wrong input: we need the diagonal!!!!', i
-      else
+      else if (parms%aggr_filter == amg_filter_mat_) then
+        ! We perform filtering in the standard way assuming that A is an M-matrix
         acsrf%val(jd)=acsrf%val(jd)-tmp
+      else if (parms%aggr_filter == amg_filter_prow_mat_) then
+        ! We are probably doing l1-correction, hence we want to preserve the
+        ! row sum of the matrix: note the change in sign
+        acsrf%val(jd)=acsrf%val(jd)+tmp
       end if
     enddo
+    !$OMP end parallel do 
     ! Take out zeroed terms 
     call acsrf%clean_zeros(info)
   end if
 
-
+  !$OMP parallel do private(i) schedule(static)
   do i=1,size(adiag)
     if (adiag(i) /= czero) then
       adiag(i) = cone / adiag(i)
@@ -226,17 +280,20 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
       adiag(i) = cone
     end if
   end do
-
+  !$OMP end parallel do 
   if (parms%aggr_omega_alg == amg_eig_est_) then 
 
-    if (parms%aggr_eig == amg_max_norm_) then 
+    if ( (parms%aggr_filter == amg_filter_prow_mat_).and.(do_l1correction) ) then
+      ! For l1-Jacobi this can be estimated with 1:
+      ! this makes sense only if we are preserving the row-sum!
+      parms%aggr_omega_val = done
+    else if (parms%aggr_eig == amg_max_norm_) then 
       allocate(arwsum(nrow))
       call acsr%arwsum(arwsum)      
       anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow)))
       call psb_amx(ctxt,anorm)
       omega = 4.d0/(3.d0*anorm)
       parms%aggr_omega_val = omega 
-
     else 
       info = psb_err_internal_error_
       call psb_errpush(info,name,a_err='invalid amg_aggr_eig_')
@@ -252,8 +309,9 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     call psb_errpush(info,name,a_err='invalid amg_aggr_omega_alg_')
     goto 9999
   end if
+  if (do_timings) call psb_toc(idx_phase1)
 
-  
+  if (do_timings) call psb_tic(idx_phase2)
   call acsrf%scal(adiag,info)
   if (info /= psb_success_) goto 9999
 
@@ -267,6 +325,8 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   call psb_cdasb(desc_ac,info)
   call psb_cd_reinit(desc_ac,info)
+  if (do_timings) call psb_toc(idx_phase2)
+  if (do_timings) call psb_tic(idx_phase3)
   !
   ! Build the smoothed prolongator using either A or Af
   !    acsr1 = (I-w*D*A) Prol      acsr1 = (I-w*D*Af) Prol 
@@ -279,8 +339,8 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
     goto 9999
   end if
-
-
+  if (do_timings) call psb_toc(idx_phase3)
+  if (do_timings) call psb_tic(idx_ptap)
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done SPSPMM 1'
@@ -292,10 +352,11 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   call op_prol%mv_from(coo_prol)
   call op_restr%mv_from(coo_restr)
-
+  if (do_timings) call psb_toc(idx_ptap)
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '
+  if (allocated(l1rwsum)) deallocate(l1rwsum)
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_d_dec_aggregator_mat_bld.f90

@@ -177,23 +177,24 @@ subroutine  amg_d_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   select case (parms%aggr_prol)
   case (amg_no_smooth_) 
 
-    call amg_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,&
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_daggrmat_nosmth_bld(parms%aggr_prol,a,desc_a,ilaggr,&
+            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
-  case(amg_smooth_prol_) 
+  case(amg_smooth_prol_,amg_l1_smooth_prol_) 
 
-    call amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr, &
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_daggrmat_smth_bld(parms%aggr_prol,a,desc_a,&
+            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,&
+            op_restr,t_prol,info)
 
 !!$  case(amg_biz_prol_) 
 !!$
 !!$    call amg_daggrmat_biz_bld(a,desc_a,ilaggr,nlaggr, &
 !!$         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
-
+  
   case(amg_min_energy_) 
 
-    call amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, &
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_daggrmat_minnrg_bld(parms%aggr_prol,a,desc_a,ilaggr,&
+            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
   case default
     info = psb_err_internal_error_

amgprec/impl/aggregator/amg_d_dec_aggregator_tprol.f90

@@ -97,6 +97,8 @@ subroutine  amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
   integer(psb_lpk_)   :: ntaggr
   integer(psb_ipk_)   :: debug_level, debug_unit
   logical             :: clean_zeros
+  integer(psb_ipk_), save :: idx_map_bld=-1, idx_map_tprol=-1
+  logical, parameter      :: do_timings=.false.
 
   name='amg_d_dec_aggregator_tprol'
   call psb_erractionsave(err_act)
@@ -108,6 +110,10 @@ subroutine  amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
+  if ((do_timings).and.(idx_map_bld==-1))       &
+       & idx_map_bld = psb_get_timer_idx("DEC_TPROL: map_bld")
+  if ((do_timings).and.(idx_map_tprol==-1))     &
+       & idx_map_tprol = psb_get_timer_idx("DEC_TPROL: map_tprol")
 
   call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
        &   amg_mult_ml_,is_legal_ml_cycle)
@@ -121,10 +127,14 @@ subroutine  amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
   ! The decoupled aggregator based on SOC measures ignores
   ! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
   !
+  if (do_timings) call psb_tic(idx_map_bld)
   clean_zeros = ag%do_clean_zeros
   call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
+  if (do_timings) call psb_toc(idx_map_bld)
+  if (do_timings) call psb_tic(idx_map_tprol)
 
   if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
+  if (do_timings) call psb_toc(idx_map_tprol)
   if (info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

amgprec/impl/aggregator/amg_d_parmatch_aggregator_mat_bld.F90

@@ -184,20 +184,23 @@ subroutine  amg_d_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   !
   select case (parms%aggr_prol)
   case (amg_no_smooth_)
-    call amg_d_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_d_parmatch_unsmth_bld(parms%aggr_prol,ag,a,desc_a,&
+            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,op_restr,&
+            t_prol,info)
 
-  case(amg_smooth_prol_)
-    call amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
+  case(amg_smooth_prol_,amg_l1_smooth_prol_)
+    call amg_d_parmatch_smth_bld(parms%aggr_prol,ag,a,desc_a,&
+            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,op_restr,&
+            t_prol,info)
 
 !!$  case(amg_biz_prol_)
 !!$    call amg_daggrmat_biz_bld(a,desc_a,ilaggr,nlaggr, &
 !!$         & parms,ac,desc_ac,op_prol,op_restr,info)
 
   case(amg_min_energy_)
-    call amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, &
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_daggrmat_minnrg_bld(parms%aggr_prol,a,desc_a,&
+            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,op_restr,&
+            t_prol,info)
 
   case default
     info = psb_err_internal_error_

amgprec/impl/aggregator/amg_d_parmatch_smth_bld.F90

@@ -69,6 +69,8 @@
 !
 !
 ! Arguments:
+!    dol1smoothing - Select between l1-Jacobi and Jacobi as smoother for the
+!                  tentative prolongator
 !    a          -  type(psb_dspmat_type), input.
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -102,8 +104,8 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
+                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_d_inner_mod
@@ -116,6 +118,7 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   implicit none
 
   ! Arguments
+  integer(psb_ipk_), intent(in)            :: dol1smoothing
   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
@@ -137,7 +140,7 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   type(psb_d_coo_sparse_mat)  :: coo_prol, coo_restr
   type(psb_d_csr_sparse_mat)  :: acsrf, csr_prol, acsr, tcsr
   real(psb_dpk_), allocatable :: adiag(:)
-  real(psb_dpk_), allocatable :: arwsum(:)
+  real(psb_dpk_), allocatable :: arwsum(:),l1rwsum(:)
   logical            :: filter_mat
   integer(psb_ipk_)            :: debug_level, debug_unit, err_act
   integer(psb_ipk_), parameter :: ncmax=16
@@ -145,6 +148,7 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   logical, parameter :: debug_new=.false., dump_r=.false., dump_p=.false., debug=.false.
   character(len=80) :: filename
   logical, parameter :: do_timings=.false.
+  logical :: do_l1correction=.false.
   integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1, idx_phase3=-1
   integer(psb_ipk_), save :: idx_cdasb=-1, idx_ptap=-1
 
@@ -166,6 +170,10 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   ncol  = desc_a%get_local_cols()
 
   theta = parms%aggr_thresh
+  ! Check if we have to perform l1-Jacobi or Jacobi as smoother
+  if(dol1smoothing.eq.amg_l1_smooth_prol_) do_l1correction=.true.
+
+
   !write(0,*) me,' ',trim(name),' Start ',idx_spspmm
   if ((do_timings).and.(idx_spspmm==-1)) &
        & idx_spspmm = psb_get_timer_idx("PMC_SMTH_BLD: par_spspmm")
@@ -217,6 +225,19 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
   if (info == psb_success_) call a%cp_to(acsr)
+  ! Get the l1-diagonal of D
+  if (do_l1correction) then
+    allocate(l1rwsum(nrow))
+    call acsr%arwsum(l1rwsum)
+    if (info == psb_success_) &
+      & call psb_realloc(ncol,l1rwsum,info)
+    if (info == psb_success_) &
+      & call psb_halo(l1rwsum,desc_a,info)
+    ! \tilde{D}_{i,i} = \sum_{j \ne i} |a_{i,j}|
+    do i=1,size(adiag)
+      adiag(i) = adiag(i) + l1rwsum(i) - abs(adiag(i))
+    end do
+  end if
 
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
@@ -246,7 +267,7 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
 
       enddo
       if (jd == -1) then
-        write(0,*) 'Wrong input: we need the diagonal!!!!', i
+        write(0,*) name,': Warning: there is no diagonal element', i
       else
         acsrf%val(jd)=acsrf%val(jd)-tmp
       end if
@@ -267,7 +288,10 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
 
   if (parms%aggr_omega_alg == amg_eig_est_) then
 
-    if (parms%aggr_eig == amg_max_norm_) then
+    if (do_l1correction) then
+      ! For l1-Jacobi this can be estimated with 1
+      parms%aggr_omega_val = done
+    else if (parms%aggr_eig == amg_max_norm_) then
       allocate(arwsum(nrow))
       call acsr%arwsum(arwsum)
       anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow)))
@@ -373,6 +397,7 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
 
     end block
   end if
+  if (allocated(l1rwsum)) deallocate(l1rwsum)
   if (do_timings) call psb_toc(idx_phase2)
 
   if (debug_level >= psb_debug_outer_) &

amgprec/impl/aggregator/amg_d_parmatch_unsmth_bld.F90

@@ -68,6 +68,8 @@
 !
 !
 ! Arguments:
+!    dol1smoothing - this not actually used inside unsmoothed aggregation, it
+!                  is used just to perform a check
 !    a          -  type(psb_dspmat_type), input.
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -101,8 +103,8 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_d_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_d_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
+                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_d_inner_mod
@@ -115,6 +117,7 @@ subroutine amg_d_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   implicit none
 
   ! Arguments
+  integer(psb_ipk_), intent(in) :: dol1smoothing
   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
@@ -159,6 +162,11 @@ subroutine amg_d_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   ictxt = desc_a%get_context()
 
   call psb_info(ictxt, me, np)
+  if (dol1smoothing.ne.amg_no_smooth_) then
+    info=psb_err_fatal_;         
+    call psb_errpush(info,name,a_err='Are you trying to smooth an unsmoothed aggregation?')
+    goto 9999
+  end if
 
 #if !defined(SERIAL_MPI)
   nglob = desc_a%get_global_rows()

amgprec/impl/aggregator/amg_d_ptap_bld.f90

@@ -76,7 +76,7 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   integer(psb_ipk_) :: nrow, ncol, nrl, nzl, ip, nzt, i, k
   integer(psb_lpk_) ::  nrsave, ncsave, nzsave, nza
   logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.  
-  integer(psb_ipk_), save :: idx_spspmm=-1
+  integer(psb_ipk_), save :: idx_spspmm=-1, idx_cpytrans1=-1, idx_cpytrans2=-1
 
   name='amg_ptap_bld'
   if(psb_get_errstatus().ne.0) return 
@@ -93,7 +93,11 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ncol  = desc_a%get_local_cols()
 
   if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("SPMM_BLD: par_spspmm")
+       & idx_spspmm = psb_get_timer_idx("PTAP_BLD: par_spspmm")
+  if ((do_timings).and.(idx_cpytrans1==-1)) &
+       & idx_cpytrans1 = psb_get_timer_idx("PTAP_BLD: cpy&trans1")
+  if ((do_timings).and.(idx_cpytrans2==-1)) &
+       & idx_cpytrans2 = psb_get_timer_idx("PTAP_BLD: cpy&trans2")
 
   naggr   = nlaggr(me+1)
   ntaggr  = sum(nlaggr)
@@ -128,6 +132,7 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ! Ok first product done.
 
   if (present(desc_ax)) then
+    if (do_timings) call psb_tic(idx_cpytrans1)
     block 
       call coo_prol%cp_to_coo(coo_restr,info)
       call coo_restr%set_ncols(desc_ac%get_local_cols())
@@ -137,7 +142,7 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
       call coo_restr%set_ncols(desc_ax%get_local_cols())
     end block
     call csr_restr%cp_from_coo(coo_restr,info)
-
+    if (do_timings) call psb_toc(idx_cpytrans1)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999
@@ -167,27 +172,28 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
     call coo_restr%transp()
     nzl = coo_restr%get_nzeros()
-    nrl = desc_ac%get_local_rows() 
-    i=0
+    nrl = desc_ac%get_local_rows()
+    call coo_restr%fix(info)
+    i=coo_restr%get_nzeros()
     !
     ! Only keep local rows
     !
-    do k=1, nzl
-      if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then
-        i = i+1
-        coo_restr%val(i) = coo_restr%val(k)
-        coo_restr%ia(i)  = coo_restr%ia(k)
-        coo_restr%ja(i)  = coo_restr%ja(k)
+    search: do k=i,1,-1
+      if (coo_restr%ia(k) <= nrl) then
+        call coo_restr%set_nzeros(k)
+        exit search
       end if
-    end do
-    call coo_restr%set_nzeros(i)
-    call coo_restr%fix(info) 
+    end do search
+
     nzl  = coo_restr%get_nzeros()
     call coo_restr%set_nrows(desc_ac%get_local_rows())
     call coo_restr%set_ncols(desc_a%get_local_cols())
     if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
+    if (do_timings) call psb_tic(idx_cpytrans2)
+        
     call csr_restr%cp_from_coo(coo_restr,info)
 
+    if (do_timings) call psb_toc(idx_cpytrans2)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999
@@ -210,6 +216,7 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
   call ac_csr%set_nrows(desc_ac%get_local_rows())
   call ac_csr%set_ncols(desc_ac%get_local_cols())
+  call ac_csr%clean_zeros(info)
   call ac%mv_from(ac_csr)
   call ac%set_asb()
 
@@ -414,6 +421,7 @@ subroutine amg_d_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
   call ac_csr%set_nrows(desc_ac%get_local_rows())
   call ac_csr%set_ncols(desc_ac%get_local_cols())
+  call ac_csr%clean_zeros(info)
   call ac%mv_from(ac_csr)
   call ac%set_asb()
 
@@ -623,6 +631,7 @@ subroutine amg_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
   call ac_csr%set_nrows(desc_ac%get_local_rows())
   call ac_csr%set_ncols(desc_ac%get_local_cols())
+  call ac_csr%clean_zeros(info)
   call ac%mv_from(ac_csr)
   call ac%set_asb()
 

amgprec/impl/aggregator/amg_d_rap.f90

@@ -142,6 +142,7 @@ subroutine amg_d_rap(a_csr,desc_a,nlaggr,parms,ac,&
 
   call ac_csr%set_nrows(desc_ac%get_local_rows())
   call ac_csr%set_ncols(desc_ac%get_local_cols())
+  call ac_csr%clean_zeros(info)
   call ac%mv_from(ac_csr)
   call ac%set_asb()
 

amgprec/impl/aggregator/amg_d_soc1_map_bld.F90

@@ -72,7 +72,9 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   use psb_base_mod
   use amg_base_prec_type
   use amg_d_inner_mod
-
+#if defined(OPENMP)
+  use omp_lib
+#endif
   implicit none
 
   ! Arguments
@@ -85,7 +87,7 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_), intent(out)               :: info
 
   ! Local variables
-  integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:),&
+  integer(psb_ipk_), allocatable :: neigh(:), irow(:), icol(:),&
        & ideg(:), idxs(:)
   integer(psb_lpk_), allocatable :: tmpaggr(:)
   real(psb_dpk_), allocatable  :: val(:), diag(:)
@@ -99,6 +101,9 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_)   :: nrow, ncol, n_ne
   integer(psb_lpk_)   :: nrglob
   character(len=20)   :: name, ch_err
+  integer(psb_ipk_), save :: idx_soc1_p1=-1, idx_soc1_p2=-1, idx_soc1_p3=-1
+  integer(psb_ipk_), save :: idx_soc1_p0=-1
+  logical, parameter      :: do_timings=.true.
 
   info=psb_success_
   name = 'amg_soc1_map_bld'
@@ -114,6 +119,14 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nrow   = desc_a%get_local_rows()
   ncol   = desc_a%get_local_cols()
   nrglob = desc_a%get_global_rows()
+  if ((do_timings).and.(idx_soc1_p0==-1))       &
+       & idx_soc1_p0 = psb_get_timer_idx("SOC1_MAP: phase0")
+  if ((do_timings).and.(idx_soc1_p1==-1))       &
+       & idx_soc1_p1 = psb_get_timer_idx("SOC1_MAP: phase1")
+  if ((do_timings).and.(idx_soc1_p2==-1))       &
+       & idx_soc1_p2 = psb_get_timer_idx("SOC1_MAP: phase2")
+  if ((do_timings).and.(idx_soc1_p3==-1))       &
+       & idx_soc1_p3 = psb_get_timer_idx("SOC1_MAP: phase3")
 
   nr = a%get_nrows()
   nc = a%get_ncols()
@@ -133,41 +146,205 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
     goto 9999
   end if
 
+  if (do_timings) call psb_tic(idx_soc1_p0)
   call a%cp_to(acsr)
+  if (do_timings) call psb_toc(idx_soc1_p0)
   if (clean_zeros) call acsr%clean_zeros(info)
   if (iorder == amg_aggr_ord_nat_) then 
+    !$omp parallel do private(i) schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
-      idxs(i)   = i 
+      idxs(i)   = i
     end do
-  else 
+    !$omp end parallel do 
+  else
+    !$omp parallel do private(i) schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
       ideg(i)   = acsr%irp(i+1) - acsr%irp(i)
     end do
+    !$omp end parallel do 
     call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
   end if
-
+  if (do_timings) call psb_tic(idx_soc1_p1)
 
   !
   ! Phase one: Start with disjoint groups.
   ! 
   naggr = 0
-  icnt = 0
+#if defined(OPENMP)
+  block
+    integer(psb_ipk_), allocatable  :: bnds(:), locnaggr(:)
+    integer(psb_ipk_) :: myth,nths, kk
+    ! The parallelization makes use of a locaggr(:) array; each thread
+    ! keeps its own version of naggr, and when the loop ends, a prefix is applied
+    ! to locnaggr to determine:
+    ! 1. The total number of aggregaters NAGGR;
+    ! 2. How much should each thread shift its own aggregates
+    ! Part 2 requires to keep track of which thread defined each entry
+    ! of ilaggr(), so that each entry can be adjusted correctly: even
+    ! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
+    ! been set because it is strongly connected to an entry J belonging to a
+    ! different thread. 
+
+    !$omp parallel shared(bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
+    !$omp private(icol,val,myth,kk) 
+    block
+      integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz, nc, i,j,m, nz, ilg,  ip, rsz
+      integer(psb_lpk_) :: itmp
+      !$omp master
+      nths = omp_get_num_threads()
+      allocate(bnds(0:nths),locnaggr(0:nths+1))
+      locnaggr(:) = 0
+      bnds(0) = 1
+      !$omp end master      
+      !$omp barrier
+      myth = omp_get_thread_num()
+      rsz = nr/nths
+      if (myth < mod(nr,nths)) rsz = rsz + 1
+      bnds(myth+1) = rsz
+      !$omp barrier
+      !$omp master
+      do i=1,nths
+        bnds(i) = bnds(i) + bnds(i-1)
+      end do
+      info = 0
+      !$omp end master
+      !$omp barrier
+      
+      !$omp do schedule(static) private(disjoint) 
+      do kk=0, nths-1
+        step1: do ii=bnds(kk), bnds(kk+1)-1
+          i = idxs(ii)          
+          if (info /= 0) cycle step1
+          if ((i<1).or.(i>nr)) then
+            !$omp atomic write
+            info=psb_err_internal_error_
+            !$omp end atomic 
+            call psb_errpush(info,name)
+            cycle step1
+            !goto 9999
+          end if
+            
+          if (ilaggr(i) == -(nr+1)) then
+            nz         = (acsr%irp(i+1)-acsr%irp(i))
+            if ((nz<0).or.(nz>size(icol))) then
+              !$omp atomic write
+              info=psb_err_internal_error_
+              !$omp end atomic 
+              call psb_errpush(info,name)
+              cycle step1
+              !goto 9999
+            end if
+
+            icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
+            val(1:nz)  = acsr%val(acsr%irp(i):acsr%irp(i+1)-1) 
+
+            !
+            ! Build the set of all strongly coupled nodes 
+            !
+            ip = 0
+            do k=1, nz
+              j   = icol(k)
+              ! If any of the neighbours is already assigned,
+              ! we will not reset. 
+              if (j>nr) cycle step1
+              if (ilaggr(j) > 0) cycle step1
+              if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.dzero)) then
+                ip = ip + 1
+                icol(ip) = icol(k)
+              end if
+            enddo
+            
+            !
+            ! If the whole strongly coupled neighborhood of I is
+            ! as yet unconnected, turn it into the next aggregate.
+            ! Same if ip==0 (in which case, neighborhood only
+            ! contains I even if it does not look like it from matrix)
+            ! The fact that DISJOINT is private and not under lock
+            ! generates a certain un-repeatability, in that between
+            ! computing DISJOINT and assigning, another thread might
+            ! alter the values of ILAGGR.
+            ! However, a certain unrepeatability is already present
+            ! because the sequence of aggregates is computed with a
+            ! different order than in serial mode.
+            ! In any case, even if the enteries of ILAGGR may be
+            ! overwritten, the important thing is that each entry is
+            ! consistent and they generate a correct aggregation map.
+            !
+            disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
+            if (disjoint) then
+              locnaggr(kk)     = locnaggr(kk) + 1
+              itmp = (bnds(kk)-1+locnaggr(kk)) !be careful about overflow
+              itmp = itmp*nths+kk
+              if (itmp < (bnds(kk)-1+locnaggr(kk))) then
+                !$omp atomic update
+                info = max(12345678,info)
+                !$omp end atomic
+                cycle step1
+              end if
+              !$omp atomic write
+              ilaggr(i) = itmp
+              !$omp end atomic
+              do k=1, ip
+                !$omp atomic write
+                ilaggr(icol(k)) = itmp
+                !$omp end atomic
+              end do
+            end if
+          end if
+        enddo step1
+      end do
+      !$omp end do
+
+      !$omp master
+      naggr = sum(locnaggr(0:nths-1))
+      do i=1,nths
+        locnaggr(i) = locnaggr(i) + locnaggr(i-1)
+      end do
+      do i=nths+1,1,-1
+        locnaggr(i) = locnaggr(i-1)
+      end do
+      locnaggr(0) = 0
+      !$omp end master 
+      !$omp barrier
+      !$omp  do schedule(static) 
+      do kk=0, nths-1
+        do ii=bnds(kk), bnds(kk+1)-1
+          if (ilaggr(ii) > 0) then 
+            kp = mod(ilaggr(ii),nths)
+            ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
+          end if
+        end do
+      end do
+      !$omp end do
+    end block
+    !$omp end parallel
+  end block
+  if (info /= 0) then
+    if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
+    info=psb_err_internal_error_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+#else
   step1: do ii=1, nr
+    if (info /= 0) cycle
     i = idxs(ii)
     if ((i<1).or.(i>nr)) then
       info=psb_err_internal_error_
       call psb_errpush(info,name)
-      goto 9999
+      cycle step1
+      !goto 9999
     end if
-    
+
     if (ilaggr(i) == -(nr+1)) then
       nz         = (acsr%irp(i+1)-acsr%irp(i))
       if ((nz<0).or.(nz>size(icol))) then
         info=psb_err_internal_error_
         call psb_errpush(info,name)
-        goto 9999
+        cycle step1
+        !goto 9999
       end if
 
       icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
@@ -176,11 +353,11 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       !
       ! Build the set of all strongly coupled nodes 
       !
-      ip = 0 
+      ip = 0
       do k=1, nz
         j   = icol(k)
         if ((1<=j).and.(j<=nr)) then 
-          if (abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))) then
+          if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.dzero)) then
             ip = ip + 1
             icol(ip) = icol(k)
           end if
@@ -194,8 +371,7 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       ! contains I even if it does not look like it from matrix)
       !
       disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
-      if (disjoint) then 
-        icnt      = icnt + 1 
+      if (disjoint) then       
         naggr     = naggr + 1
         do k=1, ip
           ilaggr(icol(k)) = naggr
@@ -204,16 +380,22 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     endif
   enddo step1
-  
+#endif
   if (debug_level >= psb_debug_outer_) then 
     write(debug_unit,*) me,' ',trim(name),&
-         & ' Check 1:',count(ilaggr == -(nr+1))
+         & ' Check   1:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
+         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
   end if
-
+  if (do_timings) call psb_toc(idx_soc1_p1)
+  if (do_timings) call psb_tic(idx_soc1_p2)
   !
   ! Phase two: join the neighbours
   !
+  !$omp workshare
   tmpaggr = ilaggr
+  !$omp end workshare
+  !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,theta)& 
+  !$omp     private(ii,i,j,k,nz,icol,val,ip,cpling)
   step2: do ii=1,nr
     i = idxs(ii)
 
@@ -244,8 +426,15 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     end if
   end do step2
+  !$omp end parallel do
+  if (do_timings) call psb_toc(idx_soc1_p2)
+  if (debug_level >= psb_debug_outer_) then 
+    write(debug_unit,*) me,' ',trim(name),&
+         & ' Check 1.5:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
+         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
+  end if
 
-
+  if (do_timings) call psb_tic(idx_soc1_p3)
   !
   ! Phase three: sweep over leftovers, if any 
   !
@@ -274,7 +463,6 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         end if
       enddo
       if (ip > 0) then
-        icnt      = icnt + 1 
         naggr     = naggr + 1
         ilaggr(i) = naggr
         do k=1, ip
@@ -292,7 +480,10 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   end do step3
 
   ! Any leftovers?
+  !$omp parallel do schedule(static) shared(ilaggr,info)& 
+  !$omp     private(ii,i,j,k,nz,icol,val,ip)
   do i=1, nr
+    if (info /= 0) cycle
     if (ilaggr(i) < 0) then
       nz = (acsr%irp(i+1)-acsr%irp(i))
       if (nz == 1) then
@@ -303,15 +494,18 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         ! other processes. 
         ilaggr(i) = -(nrglob+nr)
       else
+        !$omp atomic write
         info=psb_err_internal_error_
+        !$omp end atomic
         call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
-        goto 9999
+        cycle 
       endif
     end if
   end do
-
+  !$omp end parallel do
+  if (info /= 0) goto 9999
+  if (do_timings) call psb_toc(idx_soc1_p3)
   if (naggr > ncol) then 
-    !write(0,*) name,'Error : naggr > ncol',naggr,ncol
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')
     goto 9999
@@ -336,9 +530,13 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nlaggr(:) = 0
   nlaggr(me+1) = naggr
   call psb_sum(ctxt,nlaggr(1:np))
+  if (debug_level >= psb_debug_outer_) then 
+    write(debug_unit,*) me,' ',trim(name),&
+         & ' Check   2:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
+         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
+  end if
 
   call acsr%free()
-
   call psb_erractionrestore(err_act)
   return
 
@@ -347,4 +545,3 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   return
 
 end subroutine amg_d_soc1_map_bld
-

amgprec/impl/aggregator/amg_d_soc2_map_bld.F90

@@ -68,9 +68,12 @@
 !
 subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
 
-  use psb_base_mod
+  use psb_base_mod 
   use amg_base_prec_type
   use amg_d_inner_mod
+#if defined(OPENMP)
+  use omp_lib
+#endif
 
   implicit none
 
@@ -99,6 +102,9 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_) :: np, me
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
+  integer(psb_ipk_), save :: idx_soc2_p1=-1, idx_soc2_p2=-1, idx_soc2_p3=-1
+  integer(psb_ipk_), save :: idx_soc2_p0=-1
+  logical, parameter      :: do_timings=.true.
 
   info=psb_success_
   name = 'amg_soc2_map_bld'
@@ -114,6 +120,14 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nrow   = desc_a%get_local_rows()
   ncol   = desc_a%get_local_cols()
   nrglob = desc_a%get_global_rows()
+  if ((do_timings).and.(idx_soc2_p0==-1))       &
+       & idx_soc2_p0 = psb_get_timer_idx("SOC2_MAP: phase0")
+  if ((do_timings).and.(idx_soc2_p1==-1))       &
+       & idx_soc2_p1 = psb_get_timer_idx("SOC2_MAP: phase1")
+  if ((do_timings).and.(idx_soc2_p2==-1))       &
+       & idx_soc2_p2 = psb_get_timer_idx("SOC2_MAP: phase2")
+  if ((do_timings).and.(idx_soc2_p3==-1))       &
+       & idx_soc2_p3 = psb_get_timer_idx("SOC2_MAP: phase3")
 
   nr = a%get_nrows()
   nc = a%get_ncols()
@@ -125,6 +139,7 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
     goto 9999
   end if
 
+  if (do_timings) call psb_tic(idx_soc2_p0)
   diag = a%get_diag(info)
   if(info /= psb_success_) then
     info=psb_err_from_subroutine_
@@ -137,55 +152,218 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   ! 
   call a%cp_to(muij)
   if (clean_zeros) call muij%clean_zeros(info)
+  !$omp parallel do private(i,j,k) shared(nr,diag,muij) schedule(static)
   do i=1, nr
     do k=muij%irp(i),muij%irp(i+1)-1
       j = muij%ja(k)
       if (j<= nr) muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
     end do
   end do
-
+  !$omp end parallel do 
   !
   ! Compute the 1-neigbour; mark strong links with +1, weak links with -1
   !
   call s_neigh_coo%allocate(nr,nr,muij%get_nzeros())
-  ip = 0 
+  !$omp parallel do private(i,j,k) shared(nr,diag,muij) schedule(static)
   do i=1, nr
     do k=muij%irp(i),muij%irp(i+1)-1
       j = muij%ja(k)
+      s_neigh_coo%ia(k)  = i
+      s_neigh_coo%ja(k)  = j
       if (j<=nr) then 
-        ip = ip + 1
-        s_neigh_coo%ia(ip)  = i
-        s_neigh_coo%ja(ip)  = j
         if (real(muij%val(k)) >= theta) then 
-          s_neigh_coo%val(ip) = done
+          s_neigh_coo%val(k) = done
         else
-          s_neigh_coo%val(ip) = -done
+          s_neigh_coo%val(k) = -done
         end if
+      else
+        s_neigh_coo%val(k) = -done        
       end if
     end do
   end do
+  !$omp end parallel do
   !write(*,*) 'S_NEIGH: ',nr,ip
-  call s_neigh_coo%set_nzeros(ip)
+  call s_neigh_coo%set_nzeros(muij%get_nzeros())
   call s_neigh%mv_from_coo(s_neigh_coo,info)
 
-  if (iorder == amg_aggr_ord_nat_) then 
+  if (iorder == amg_aggr_ord_nat_) then
+    
+    !$omp parallel do private(i) shared(ilaggr,idxs) schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
       idxs(i)   = i 
     end do
+    !$omp end parallel do 
   else 
+    !$omp parallel do private(i) shared(ilaggr,idxs,muij)  schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
       ideg(i)   = muij%irp(i+1) - muij%irp(i)
     end do
+    !$omp end parallel do
     call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
   end if
 
+  if (do_timings) call psb_toc(idx_soc2_p0)
+  if (do_timings) call psb_tic(idx_soc2_p1)
 
   !
   ! Phase one: Start with disjoint groups.
   ! 
   naggr = 0
+#if defined(OPENMP)
+  block
+    integer(psb_ipk_), allocatable  :: bnds(:), locnaggr(:)
+    integer(psb_ipk_) :: myth,nths, kk
+    ! The parallelization makes use of a locaggr(:) array; each thread
+    ! keeps its own version of naggr, and when the loop ends, a prefix is applied
+    ! to locnaggr to determine:
+    ! 1. The total number of aggregaters NAGGR;
+    ! 2. How much should each thread shift its own aggregates
+    ! Part 2 requires to keep track of which thread defined each entry
+    ! of ilaggr(), so that each entry can be adjusted correctly: even
+    ! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
+    ! been set because it is strongly connected to an entry J belonging to a
+    ! different thread. 
+
+    !$omp parallel shared(s_neigh,bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
+    !$omp private(icol,val,myth,kk) 
+    block
+      integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz,nc,i,j,m,nz,ilg,ip,rsz,ip1,nzcnt
+      integer(psb_lpk_) :: itmp
+      !$omp master
+      nths = omp_get_num_threads()
+      allocate(bnds(0:nths),locnaggr(0:nths+1))
+      locnaggr(:) = 0
+      bnds(0) = 1
+      !$omp end master      
+      !$omp barrier
+      myth = omp_get_thread_num()
+      rsz = nr/nths
+      if (myth < mod(nr,nths)) rsz = rsz + 1
+      bnds(myth+1) = rsz
+      !$omp barrier
+      !$omp master
+      do i=1,nths
+        bnds(i) = bnds(i) + bnds(i-1)
+      end do
+      info = 0
+      !$omp end master
+      !$omp barrier
+
+      !$omp do schedule(static) private(disjoint) 
+      do kk=0, nths-1
+        step1: do ii=bnds(kk), bnds(kk+1)-1
+          i = idxs(ii)
+          if (info /= 0) then
+            write(0,*) ' Step1:',kk,ii,i,info
+            cycle step1
+          end if
+          if ((i<1).or.(i>nr)) then
+            !$omp atomic write
+            info=psb_err_internal_error_
+            !$omp end atomic 
+            call psb_errpush(info,name)
+            cycle step1
+            !goto 9999
+          end if
+
+
+          if (ilaggr(i) == -(nr+1)) then 
+            !
+            ! Get the 1-neighbourhood of I 
+            !
+            ip1 = s_neigh%irp(i)
+            nz  = s_neigh%irp(i+1)-ip1
+            !
+            ! If the neighbourhood only contains I, skip it
+            !
+            if (nz ==0) then
+              ilaggr(i) = 0
+              cycle step1
+            end if
+            if ((nz==1).and.(s_neigh%ja(ip1)==i)) then
+              ilaggr(i) = 0
+              cycle step1
+            end if
+
+            nzcnt = count(real(s_neigh%val(ip1:ip1+nz-1)) > 0)
+            icol(1:nzcnt) = pack(s_neigh%ja(ip1:ip1+nz-1),(real(s_neigh%val(ip1:ip1+nz-1)) > 0))
+            disjoint = all(ilaggr(icol(1:nzcnt)) == -(nr+1)) 
+
+            !
+            ! If the whole strongly coupled neighborhood of I is
+            ! as yet unconnected, turn it into the next aggregate.
+            ! Same if ip==0 (in which case, neighborhood only
+            ! contains I even if it does not look like it from matrix)
+            ! The fact that DISJOINT is private and not under lock
+            ! generates a certain un-repeatability, in that between
+            ! computing DISJOINT and assigning, another thread might
+            ! alter the values of ILAGGR.
+            ! However, a certain unrepeatability is already present
+            ! because the sequence of aggregates is computed with a
+            ! different order than in serial mode.
+            ! In any case, even if the enteries of ILAGGR may be
+            ! overwritten, the important thing is that each entry is
+            ! consistent and they generate a correct aggregation map.
+            !
+            if (disjoint) then
+              locnaggr(kk)     = locnaggr(kk) + 1
+              itmp = (bnds(kk)-1+locnaggr(kk)) !be careful about overflow
+              itmp = itmp*nths+kk
+              if (itmp < (bnds(kk)-1+locnaggr(kk))) then
+                !$omp atomic update
+                info = max(12345678,info)
+                !$omp end atomic
+                cycle step1
+              end if
+              !$omp atomic write
+              ilaggr(i) = itmp
+              !$omp end atomic
+              do k=1, nzcnt
+                !$omp atomic write
+                ilaggr(icol(k)) = itmp
+                !$omp end atomic
+              end do
+            end if
+          end if
+        enddo step1
+      end do
+      !$omp end do
+
+      !$omp master
+      naggr = sum(locnaggr(0:nths-1))
+      do i=1,nths
+        locnaggr(i) = locnaggr(i) + locnaggr(i-1)
+      end do
+      do i=nths+1,1,-1
+        locnaggr(i) = locnaggr(i-1)
+      end do
+      locnaggr(0) = 0
+      !write(0,*) 'LNAG ',locnaggr(nths+1)
+      !$omp end master 
+      !$omp barrier
+      !$omp  do schedule(static) 
+      do kk=0, nths-1
+        do ii=bnds(kk), bnds(kk+1)-1
+          if (ilaggr(ii) > 0) then 
+            kp = mod(ilaggr(ii),nths)
+            ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
+          end if
+        end do
+      end do
+      !$omp end do
+    end block
+    !$omp end parallel
+  end block
+  if (info /= 0) then
+    if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
+    info=psb_err_internal_error_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+#else
   icnt = 0
   step1: do ii=1, nr
     i = idxs(ii)
@@ -224,16 +402,21 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     endif
   enddo step1
-  
+#endif  
   if (debug_level >= psb_debug_outer_) then 
     write(debug_unit,*) me,' ',trim(name),&
          & ' Check 1:',count(ilaggr == -(nr+1))
   end if
-
+  if (do_timings) call psb_toc(idx_soc2_p1)
+  if (do_timings) call psb_tic(idx_soc2_p2)
   !
   ! Phase two: join the neighbours
   !
+  !$omp workshare
   tmpaggr = ilaggr
+  !$omp end workshare
+  !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,muij,s_neigh)& 
+  !$omp     private(ii,i,j,k,nz,icol,val,ip,cpling)
   step2: do ii=1,nr
     i = idxs(ii)
 
@@ -259,8 +442,9 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     end if
   end do step2
-
-
+  !$omp end parallel do
+  if (do_timings) call psb_toc(idx_soc2_p2)
+  if (do_timings) call psb_tic(idx_soc2_p3)
   !
   ! Phase three: sweep over leftovers, if any 
   !
@@ -294,6 +478,8 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   end do step3
 
   ! Any leftovers?
+  !$omp parallel do schedule(static) shared(ilaggr,s_neigh,info)& 
+  !$omp     private(ii,i,j,k)
   do i=1, nr
     if (ilaggr(i) <= 0) then
       nz = (s_neigh%irp(i+1)-s_neigh%irp(i))
@@ -305,13 +491,17 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         ! other processes. 
         ilaggr(i) = -(nrglob+nr)
       else
+        !$omp atomic write
         info=psb_err_internal_error_
+        !$omp end atomic
         call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
-        goto 9999
+        cycle
       endif
     end if
   end do
-
+  !$omp end parallel do
+  if (info /= 0) goto 9999
+  if (do_timings) call psb_toc(idx_soc2_p3)  
   if (naggr > ncol) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')

amgprec/impl/aggregator/amg_daggrmat_minnrg_bld.f90

@@ -69,6 +69,7 @@
 !
 !
 ! Arguments:
+!    dol1smoothing - fictitious integer argument, it is not used inside
 !    a          -  type(psb_dspmat_type), input.     
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -104,8 +105,8 @@
 !                  Error code.
 !
 !
-subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_daggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
+                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_d_inner_mod, amg_protect_name => amg_daggrmat_minnrg_bld
@@ -113,6 +114,7 @@ subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
   implicit none
 
   ! Arguments
+  integer(psb_ipk_), intent(in)                 :: dol1smoothing
   type(psb_dspmat_type), intent(in)           :: a
   type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
@@ -171,6 +173,13 @@ subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   filter_mat = (parms%aggr_filter == amg_filter_mat_)
 
+  if (dol1smoothing.ne.amg_no_smooth_) then
+    info=psb_err_fatal_; 
+    call psb_errpush(info,name,a_err='Are you trying to smooth an unsmoothed aggregation?')
+    goto 9999
+  end if
+
+
   !NEEDS TO BE REWORKED !!
   
   ! naggr: number of local aggregates
@@ -300,7 +309,7 @@ subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
 !!$        endif
 !!$      enddo
 !!$      if (jd == -1) then 
-!!$        write(0,*) 'Wrong input: we need the diagonal!!!!', i
+!!$                write(0,*) name,': Warning: there is no diagonal element', i
 !!$      else
 !!$        acsrf%val(jd)=acsrf%val(jd)-tmp
 !!$      end if

amgprec/impl/aggregator/amg_daggrmat_nosmth_bld.f90

@@ -94,10 +94,11 @@
 !               
 !    info       -  integer, output.
 !                  Error code.
+!    dol1smoothing - optional, this is here just for interfacing reasons. It is not used by the
+!                    code
 !
-!
-subroutine amg_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_daggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
+                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_d_inner_mod, amg_protect_name => amg_daggrmat_nosmth_bld
@@ -105,6 +106,7 @@ subroutine amg_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   implicit none
 
   ! Arguments
+  integer(psb_ipk_), intent(in)              :: dol1smoothing 
   type(psb_dspmat_type), intent(in)        :: a
   type(psb_desc_type), intent(inout)         :: desc_a
   integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
@@ -137,6 +139,12 @@ subroutine amg_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   ctxt = desc_a%get_context()
   call psb_info(ctxt, me, np)
+  if (dol1smoothing.ne.amg_no_smooth_) then
+    info=psb_err_fatal_;         
+    call psb_errpush(info,name,a_err='Are you trying to smooth an unsmoothed aggregation?')
+    goto 9999
+  end if
+
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
   ncol  = desc_a%get_local_cols()

amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90

@@ -69,6 +69,8 @@
 !
 !
 ! Arguments:
+!    dol1smooth -  Integer taking the type of smoother that has to be used
+!                  on the tentative prolongator
 !    a          -  type(psb_dspmat_type), input.     
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -102,16 +104,18 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_daggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
+                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_d_inner_mod, amg_protect_name => amg_daggrmat_smth_bld
   use amg_d_base_aggregator_mod
+!  use, intrinsic :: ieee_arithmetic
 
   implicit none
 
   ! Arguments
+  integer(psb_ipk_), intent(in)            :: dol1smoothing
   type(psb_dspmat_type), intent(in)      :: a
   type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
@@ -132,7 +136,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   type(psb_d_coo_sparse_mat) :: coo_prol, coo_restr
   type(psb_d_csr_sparse_mat) :: acsr1,  acsrf, csr_prol, acsr
   real(psb_dpk_), allocatable :: adiag(:)
-  real(psb_dpk_), allocatable :: arwsum(:)
+  real(psb_dpk_), allocatable :: arwsum(:),l1rwsum(:)
   integer(psb_ipk_)  :: ierr(5)
   logical            :: filter_mat
   integer(psb_ipk_)            :: debug_level, debug_unit, err_act
@@ -140,6 +144,10 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   real(psb_dpk_)     :: anorm, omega, tmp, dg, theta
   logical, parameter :: debug_new=.false.
   character(len=80) :: filename
+  logical, parameter :: do_timings=.false.
+  logical :: do_l1correction=.false.
+  integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1
+  integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1
 
   name='amg_aggrmat_smth_bld'
   info=psb_success_
@@ -153,6 +161,26 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   ctxt = desc_a%get_context()
 
   call psb_info(ctxt, me, np)
+  if ((do_timings).and.(idx_spspmm==-1)) &
+       & idx_spspmm = psb_get_timer_idx("DEC_SMTH_BLD: par_spspmm")
+  if ((do_timings).and.(idx_phase1==-1)) &
+       & idx_phase1 = psb_get_timer_idx("DEC_SMTH_BLD: phase1    ")
+  if ((do_timings).and.(idx_phase2==-1)) &
+       & idx_phase2 = psb_get_timer_idx("DEC_SMTH_BLD: phase2    ")
+  if ((do_timings).and.(idx_phase3==-1)) &
+       & idx_phase3 = psb_get_timer_idx("DEC_SMTH_BLD: phase3    ")
+  if ((do_timings).and.(idx_gtrans==-1)) &
+       & idx_gtrans = psb_get_timer_idx("DEC_SMTH_BLD: gtrans    ")
+  if ((do_timings).and.(idx_refine==-1)) &
+       & idx_refine = psb_get_timer_idx("DEC_SMTH_BLD: refine    ")
+  if ((do_timings).and.(idx_cdasb==-1)) &
+       & idx_cdasb = psb_get_timer_idx("DEC_SMTH_BLD: cdasb     ")
+  if ((do_timings).and.(idx_ptap==-1)) &
+       & idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld  ")
+
+  ! check if we have to use Jacobi or l1-Jacobi to smooth the tentative prolongator
+  if (dol1smoothing.eq.amg_l1_smooth_prol_) do_l1correction=.true.
+
 
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
@@ -165,12 +193,13 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   naggrm1 = sum(nlaggr(1:me))
   naggrp1 = sum(nlaggr(1:me+1))
-  filter_mat = (parms%aggr_filter == amg_filter_mat_)
+  filter_mat = (parms%aggr_filter == amg_filter_mat_).or.(parms%aggr_filter == amg_filter_prow_mat_)
 
   !
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
+  if (do_timings) call psb_tic(idx_phase1)
 
   ! Get the diagonal D
   adiag = a%get_diag(info)
@@ -179,6 +208,24 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
   if (info == psb_success_) call a%cp_to(acsr)
+  !
+  ! Do the l1-correction on the diagonal if it is requested
+  !
+  if (do_l1correction) then
+    allocate(l1rwsum(nrow))
+    call acsr%arwsum(l1rwsum)
+    if (info == psb_success_) &
+      & call psb_realloc(ncol,l1rwsum,info)
+    if (info == psb_success_) &
+      & call psb_halo(l1rwsum,desc_a,info)
+    ! \tilde{D}_{i,i} = \sum_{j \ne i} |a_{i,j}|
+    !$OMP parallel do private(i) schedule(static)
+    do i=1,size(adiag)
+        adiag(i) = adiag(i) + l1rwsum(i) - abs(adiag(i))
+    end do
+    !$OMP end parallel do
+  end if
+
 
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
@@ -196,7 +243,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     !
     ! Build the filtered matrix Af from A
     ! 
-
+    !$OMP parallel do private(i,j,tmp,jd) schedule(static)
     do i=1, nrow
       tmp = dzero
       jd  = -1 
@@ -209,16 +256,23 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
       enddo
       if (jd == -1) then 
+        ! if (.not.do_l1correction) 
         write(0,*) 'Wrong input: we need the diagonal!!!!', i
-      else
+      else if (parms%aggr_filter == amg_filter_mat_) then
+        ! We perform filtering in the standard way assuming that A is an M-matrix
         acsrf%val(jd)=acsrf%val(jd)-tmp
+      else if (parms%aggr_filter == amg_filter_prow_mat_) then
+        ! We are probably doing l1-correction, hence we want to preserve the
+        ! row sum of the matrix: note the change in sign
+        acsrf%val(jd)=acsrf%val(jd)+tmp
       end if
     enddo
+    !$OMP end parallel do 
     ! Take out zeroed terms 
     call acsrf%clean_zeros(info)
   end if
 
-
+  !$OMP parallel do private(i) schedule(static)
   do i=1,size(adiag)
     if (adiag(i) /= dzero) then
       adiag(i) = done / adiag(i)
@@ -226,17 +280,20 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
       adiag(i) = done
     end if
   end do
-
+  !$OMP end parallel do 
   if (parms%aggr_omega_alg == amg_eig_est_) then 
 
-    if (parms%aggr_eig == amg_max_norm_) then 
+    if ( (parms%aggr_filter == amg_filter_prow_mat_).and.(do_l1correction) ) then
+      ! For l1-Jacobi this can be estimated with 1:
+      ! this makes sense only if we are preserving the row-sum!
+      parms%aggr_omega_val = done
+    else if (parms%aggr_eig == amg_max_norm_) then 
       allocate(arwsum(nrow))
       call acsr%arwsum(arwsum)      
       anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow)))
       call psb_amx(ctxt,anorm)
       omega = 4.d0/(3.d0*anorm)
       parms%aggr_omega_val = omega 
-
     else 
       info = psb_err_internal_error_
       call psb_errpush(info,name,a_err='invalid amg_aggr_eig_')
@@ -252,8 +309,9 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     call psb_errpush(info,name,a_err='invalid amg_aggr_omega_alg_')
     goto 9999
   end if
+  if (do_timings) call psb_toc(idx_phase1)
 
-  
+  if (do_timings) call psb_tic(idx_phase2)
   call acsrf%scal(adiag,info)
   if (info /= psb_success_) goto 9999
 
@@ -267,6 +325,8 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   call psb_cdasb(desc_ac,info)
   call psb_cd_reinit(desc_ac,info)
+  if (do_timings) call psb_toc(idx_phase2)
+  if (do_timings) call psb_tic(idx_phase3)
   !
   ! Build the smoothed prolongator using either A or Af
   !    acsr1 = (I-w*D*A) Prol      acsr1 = (I-w*D*Af) Prol 
@@ -279,8 +339,8 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
     call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
     goto 9999
   end if
-
-
+  if (do_timings) call psb_toc(idx_phase3)
+  if (do_timings) call psb_tic(idx_ptap)
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done SPSPMM 1'
@@ -292,10 +352,11 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   call op_prol%mv_from(coo_prol)
   call op_restr%mv_from(coo_restr)
-
+  if (do_timings) call psb_toc(idx_ptap)
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '
+  if (allocated(l1rwsum)) deallocate(l1rwsum)
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_s_dec_aggregator_mat_bld.f90

@@ -177,23 +177,24 @@ subroutine  amg_s_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   select case (parms%aggr_prol)
   case (amg_no_smooth_) 
 
-    call amg_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,&
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_saggrmat_nosmth_bld(parms%aggr_prol,a,desc_a,ilaggr,&
+            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
-  case(amg_smooth_prol_) 
+  case(amg_smooth_prol_,amg_l1_smooth_prol_) 
 
-    call amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr, &
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_saggrmat_smth_bld(parms%aggr_prol,a,desc_a,&
+            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,&
+            op_restr,t_prol,info)
 
 !!$  case(amg_biz_prol_) 
 !!$
 !!$    call amg_saggrmat_biz_bld(a,desc_a,ilaggr,nlaggr, &
 !!$         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
-
+  
   case(amg_min_energy_) 
 
-    call amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, &
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_saggrmat_minnrg_bld(parms%aggr_prol,a,desc_a,ilaggr,&
+            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
   case default
     info = psb_err_internal_error_

amgprec/impl/aggregator/amg_s_dec_aggregator_tprol.f90

@@ -97,6 +97,8 @@ subroutine  amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
   integer(psb_lpk_)   :: ntaggr
   integer(psb_ipk_)   :: debug_level, debug_unit
   logical             :: clean_zeros
+  integer(psb_ipk_), save :: idx_map_bld=-1, idx_map_tprol=-1
+  logical, parameter      :: do_timings=.false.
 
   name='amg_s_dec_aggregator_tprol'
   call psb_erractionsave(err_act)
@@ -108,6 +110,10 @@ subroutine  amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
+  if ((do_timings).and.(idx_map_bld==-1))       &
+       & idx_map_bld = psb_get_timer_idx("DEC_TPROL: map_bld")
+  if ((do_timings).and.(idx_map_tprol==-1))     &
+       & idx_map_tprol = psb_get_timer_idx("DEC_TPROL: map_tprol")
 
   call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
        &   amg_mult_ml_,is_legal_ml_cycle)
@@ -121,10 +127,14 @@ subroutine  amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
   ! The decoupled aggregator based on SOC measures ignores
   ! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
   !
+  if (do_timings) call psb_tic(idx_map_bld)
   clean_zeros = ag%do_clean_zeros
   call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
+  if (do_timings) call psb_toc(idx_map_bld)
+  if (do_timings) call psb_tic(idx_map_tprol)
 
   if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
+  if (do_timings) call psb_toc(idx_map_tprol)
   if (info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

amgprec/impl/aggregator/amg_s_parmatch_aggregator_mat_bld.F90

@@ -184,20 +184,23 @@ subroutine  amg_s_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   !
   select case (parms%aggr_prol)
   case (amg_no_smooth_)
-    call amg_s_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_s_parmatch_unsmth_bld(parms%aggr_prol,ag,a,desc_a,&
+            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,op_restr,&
+            t_prol,info)
 
-  case(amg_smooth_prol_)
-    call amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
+  case(amg_smooth_prol_,amg_l1_smooth_prol_)
+    call amg_s_parmatch_smth_bld(parms%aggr_prol,ag,a,desc_a,&
+            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,op_restr,&
+            t_prol,info)
 
 !!$  case(amg_biz_prol_)
 !!$    call amg_saggrmat_biz_bld(a,desc_a,ilaggr,nlaggr, &
 !!$         & parms,ac,desc_ac,op_prol,op_restr,info)
 
   case(amg_min_energy_)
-    call amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, &
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_saggrmat_minnrg_bld(parms%aggr_prol,a,desc_a,&
+            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,op_restr,&
+            t_prol,info)
 
   case default
     info = psb_err_internal_error_

amgprec/impl/aggregator/amg_s_parmatch_smth_bld.F90

@@ -69,6 +69,8 @@
 !
 !
 ! Arguments:
+!    dol1smoothing - Select between l1-Jacobi and Jacobi as smoother for the
+!                  tentative prolongator
 !    a          -  type(psb_sspmat_type), input.
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -102,8 +104,8 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
+                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_s_inner_mod
@@ -116,6 +118,7 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   implicit none
 
   ! Arguments
+  integer(psb_ipk_), intent(in)            :: dol1smoothing
   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
@@ -137,7 +140,7 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   type(psb_s_coo_sparse_mat)  :: coo_prol, coo_restr
   type(psb_s_csr_sparse_mat)  :: acsrf, csr_prol, acsr, tcsr
   real(psb_spk_), allocatable :: adiag(:)
-  real(psb_spk_), allocatable :: arwsum(:)
+  real(psb_spk_), allocatable :: arwsum(:),l1rwsum(:)
   logical            :: filter_mat
   integer(psb_ipk_)            :: debug_level, debug_unit, err_act
   integer(psb_ipk_), parameter :: ncmax=16
@@ -145,6 +148,7 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   logical, parameter :: debug_new=.false., dump_r=.false., dump_p=.false., debug=.false.
   character(len=80) :: filename
   logical, parameter :: do_timings=.false.
+  logical :: do_l1correction=.false.
   integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1, idx_phase3=-1
   integer(psb_ipk_), save :: idx_cdasb=-1, idx_ptap=-1
 
@@ -166,6 +170,10 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   ncol  = desc_a%get_local_cols()
 
   theta = parms%aggr_thresh
+  ! Check if we have to perform l1-Jacobi or Jacobi as smoother
+  if(dol1smoothing.eq.amg_l1_smooth_prol_) do_l1correction=.true.
+
+
   !write(0,*) me,' ',trim(name),' Start ',idx_spspmm
   if ((do_timings).and.(idx_spspmm==-1)) &
        & idx_spspmm = psb_get_timer_idx("PMC_SMTH_BLD: par_spspmm")
@@ -217,6 +225,19 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
   if (info == psb_success_) call a%cp_to(acsr)
+  ! Get the l1-diagonal of D
+  if (do_l1correction) then
+    allocate(l1rwsum(nrow))
+    call acsr%arwsum(l1rwsum)
+    if (info == psb_success_) &
+      & call psb_realloc(ncol,l1rwsum,info)
+    if (info == psb_success_) &
+      & call psb_halo(l1rwsum,desc_a,info)
+    ! \tilde{D}_{i,i} = \sum_{j \ne i} |a_{i,j}|
+    do i=1,size(adiag)
+      adiag(i) = adiag(i) + l1rwsum(i) - abs(adiag(i))
+    end do
+  end if
 
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
@@ -246,7 +267,7 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
 
       enddo
       if (jd == -1) then
-        write(0,*) 'Wrong input: we need the diagonal!!!!', i
+        write(0,*) name,': Warning: there is no diagonal element', i
       else
         acsrf%val(jd)=acsrf%val(jd)-tmp
       end if
@@ -267,7 +288,10 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
 
   if (parms%aggr_omega_alg == amg_eig_est_) then
 
-    if (parms%aggr_eig == amg_max_norm_) then
+    if (do_l1correction) then
+      ! For l1-Jacobi this can be estimated with 1
+      parms%aggr_omega_val = done
+    else if (parms%aggr_eig == amg_max_norm_) then
       allocate(arwsum(nrow))
       call acsr%arwsum(arwsum)
       anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow)))
@@ -373,6 +397,7 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
 
     end block
   end if
+  if (allocated(l1rwsum)) deallocate(l1rwsum)
   if (do_timings) call psb_toc(idx_phase2)
 
   if (debug_level >= psb_debug_outer_) &

amgprec/impl/aggregator/amg_s_parmatch_unsmth_bld.F90

@@ -68,6 +68,8 @@
 !
 !
 ! Arguments:
+!    dol1smoothing - this not actually used inside unsmoothed aggregation, it
+!                  is used just to perform a check
 !    a          -  type(psb_sspmat_type), input.
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -101,8 +103,8 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_s_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_s_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
+                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_s_inner_mod
@@ -115,6 +117,7 @@ subroutine amg_s_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   implicit none
 
   ! Arguments
+  integer(psb_ipk_), intent(in) :: dol1smoothing
   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
@@ -159,6 +162,11 @@ subroutine amg_s_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   ictxt = desc_a%get_context()
 
   call psb_info(ictxt, me, np)
+  if (dol1smoothing.ne.amg_no_smooth_) then
+    info=psb_err_fatal_;         
+    call psb_errpush(info,name,a_err='Are you trying to smooth an unsmoothed aggregation?')
+    goto 9999
+  end if
 
 #if !defined(SERIAL_MPI)
   nglob = desc_a%get_global_rows()

amgprec/impl/aggregator/amg_s_ptap_bld.f90

@@ -76,7 +76,7 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   integer(psb_ipk_) :: nrow, ncol, nrl, nzl, ip, nzt, i, k
   integer(psb_lpk_) ::  nrsave, ncsave, nzsave, nza
   logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.  
-  integer(psb_ipk_), save :: idx_spspmm=-1
+  integer(psb_ipk_), save :: idx_spspmm=-1, idx_cpytrans1=-1, idx_cpytrans2=-1
 
   name='amg_ptap_bld'
   if(psb_get_errstatus().ne.0) return 
@@ -93,7 +93,11 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ncol  = desc_a%get_local_cols()
 
   if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("SPMM_BLD: par_spspmm")
+       & idx_spspmm = psb_get_timer_idx("PTAP_BLD: par_spspmm")
+  if ((do_timings).and.(idx_cpytrans1==-1)) &
+       & idx_cpytrans1 = psb_get_timer_idx("PTAP_BLD: cpy&trans1")
+  if ((do_timings).and.(idx_cpytrans2==-1)) &
+       & idx_cpytrans2 = psb_get_timer_idx("PTAP_BLD: cpy&trans2")
 
   naggr   = nlaggr(me+1)
   ntaggr  = sum(nlaggr)
@@ -128,6 +132,7 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ! Ok first product done.
 
   if (present(desc_ax)) then
+    if (do_timings) call psb_tic(idx_cpytrans1)
     block 
       call coo_prol%cp_to_coo(coo_restr,info)
       call coo_restr%set_ncols(desc_ac%get_local_cols())
@@ -137,7 +142,7 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
       call coo_restr%set_ncols(desc_ax%get_local_cols())
     end block
     call csr_restr%cp_from_coo(coo_restr,info)
-
+    if (do_timings) call psb_toc(idx_cpytrans1)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999
@@ -167,27 +172,28 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
     call coo_restr%transp()
     nzl = coo_restr%get_nzeros()
-    nrl = desc_ac%get_local_rows() 
-    i=0
+    nrl = desc_ac%get_local_rows()
+    call coo_restr%fix(info)
+    i=coo_restr%get_nzeros()
     !
     ! Only keep local rows
     !
-    do k=1, nzl
-      if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then
-        i = i+1
-        coo_restr%val(i) = coo_restr%val(k)
-        coo_restr%ia(i)  = coo_restr%ia(k)
-        coo_restr%ja(i)  = coo_restr%ja(k)
+    search: do k=i,1,-1
+      if (coo_restr%ia(k) <= nrl) then
+        call coo_restr%set_nzeros(k)
+        exit search
       end if
-    end do
-    call coo_restr%set_nzeros(i)
-    call coo_restr%fix(info) 
+    end do search
+
     nzl  = coo_restr%get_nzeros()
     call coo_restr%set_nrows(desc_ac%get_local_rows())
     call coo_restr%set_ncols(desc_a%get_local_cols())
     if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
+    if (do_timings) call psb_tic(idx_cpytrans2)
+        
     call csr_restr%cp_from_coo(coo_restr,info)
 
+    if (do_timings) call psb_toc(idx_cpytrans2)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999
@@ -210,6 +216,7 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
   call ac_csr%set_nrows(desc_ac%get_local_rows())
   call ac_csr%set_ncols(desc_ac%get_local_cols())
+  call ac_csr%clean_zeros(info)
   call ac%mv_from(ac_csr)
   call ac%set_asb()
 
@@ -414,6 +421,7 @@ subroutine amg_s_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
   call ac_csr%set_nrows(desc_ac%get_local_rows())
   call ac_csr%set_ncols(desc_ac%get_local_cols())
+  call ac_csr%clean_zeros(info)
   call ac%mv_from(ac_csr)
   call ac%set_asb()
 
@@ -623,6 +631,7 @@ subroutine amg_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
   call ac_csr%set_nrows(desc_ac%get_local_rows())
   call ac_csr%set_ncols(desc_ac%get_local_cols())
+  call ac_csr%clean_zeros(info)
   call ac%mv_from(ac_csr)
   call ac%set_asb()
 

amgprec/impl/aggregator/amg_s_rap.f90

@@ -142,6 +142,7 @@ subroutine amg_s_rap(a_csr,desc_a,nlaggr,parms,ac,&
 
   call ac_csr%set_nrows(desc_ac%get_local_rows())
   call ac_csr%set_ncols(desc_ac%get_local_cols())
+  call ac_csr%clean_zeros(info)
   call ac%mv_from(ac_csr)
   call ac%set_asb()
 

amgprec/impl/aggregator/amg_s_soc1_map_bld.F90

@@ -72,7 +72,9 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   use psb_base_mod
   use amg_base_prec_type
   use amg_s_inner_mod
-
+#if defined(OPENMP)
+  use omp_lib
+#endif
   implicit none
 
   ! Arguments
@@ -85,7 +87,7 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_), intent(out)               :: info
 
   ! Local variables
-  integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:),&
+  integer(psb_ipk_), allocatable :: neigh(:), irow(:), icol(:),&
        & ideg(:), idxs(:)
   integer(psb_lpk_), allocatable :: tmpaggr(:)
   real(psb_spk_), allocatable  :: val(:), diag(:)
@@ -99,6 +101,9 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_)   :: nrow, ncol, n_ne
   integer(psb_lpk_)   :: nrglob
   character(len=20)   :: name, ch_err
+  integer(psb_ipk_), save :: idx_soc1_p1=-1, idx_soc1_p2=-1, idx_soc1_p3=-1
+  integer(psb_ipk_), save :: idx_soc1_p0=-1
+  logical, parameter      :: do_timings=.true.
 
   info=psb_success_
   name = 'amg_soc1_map_bld'
@@ -114,6 +119,14 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nrow   = desc_a%get_local_rows()
   ncol   = desc_a%get_local_cols()
   nrglob = desc_a%get_global_rows()
+  if ((do_timings).and.(idx_soc1_p0==-1))       &
+       & idx_soc1_p0 = psb_get_timer_idx("SOC1_MAP: phase0")
+  if ((do_timings).and.(idx_soc1_p1==-1))       &
+       & idx_soc1_p1 = psb_get_timer_idx("SOC1_MAP: phase1")
+  if ((do_timings).and.(idx_soc1_p2==-1))       &
+       & idx_soc1_p2 = psb_get_timer_idx("SOC1_MAP: phase2")
+  if ((do_timings).and.(idx_soc1_p3==-1))       &
+       & idx_soc1_p3 = psb_get_timer_idx("SOC1_MAP: phase3")
 
   nr = a%get_nrows()
   nc = a%get_ncols()
@@ -133,41 +146,205 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
     goto 9999
   end if
 
+  if (do_timings) call psb_tic(idx_soc1_p0)
   call a%cp_to(acsr)
+  if (do_timings) call psb_toc(idx_soc1_p0)
   if (clean_zeros) call acsr%clean_zeros(info)
   if (iorder == amg_aggr_ord_nat_) then 
+    !$omp parallel do private(i) schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
-      idxs(i)   = i 
+      idxs(i)   = i
     end do
-  else 
+    !$omp end parallel do 
+  else
+    !$omp parallel do private(i) schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
       ideg(i)   = acsr%irp(i+1) - acsr%irp(i)
     end do
+    !$omp end parallel do 
     call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
   end if
-
+  if (do_timings) call psb_tic(idx_soc1_p1)
 
   !
   ! Phase one: Start with disjoint groups.
   ! 
   naggr = 0
-  icnt = 0
+#if defined(OPENMP)
+  block
+    integer(psb_ipk_), allocatable  :: bnds(:), locnaggr(:)
+    integer(psb_ipk_) :: myth,nths, kk
+    ! The parallelization makes use of a locaggr(:) array; each thread
+    ! keeps its own version of naggr, and when the loop ends, a prefix is applied
+    ! to locnaggr to determine:
+    ! 1. The total number of aggregaters NAGGR;
+    ! 2. How much should each thread shift its own aggregates
+    ! Part 2 requires to keep track of which thread defined each entry
+    ! of ilaggr(), so that each entry can be adjusted correctly: even
+    ! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
+    ! been set because it is strongly connected to an entry J belonging to a
+    ! different thread. 
+
+    !$omp parallel shared(bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
+    !$omp private(icol,val,myth,kk) 
+    block
+      integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz, nc, i,j,m, nz, ilg,  ip, rsz
+      integer(psb_lpk_) :: itmp
+      !$omp master
+      nths = omp_get_num_threads()
+      allocate(bnds(0:nths),locnaggr(0:nths+1))
+      locnaggr(:) = 0
+      bnds(0) = 1
+      !$omp end master      
+      !$omp barrier
+      myth = omp_get_thread_num()
+      rsz = nr/nths
+      if (myth < mod(nr,nths)) rsz = rsz + 1
+      bnds(myth+1) = rsz
+      !$omp barrier
+      !$omp master
+      do i=1,nths
+        bnds(i) = bnds(i) + bnds(i-1)
+      end do
+      info = 0
+      !$omp end master
+      !$omp barrier
+      
+      !$omp do schedule(static) private(disjoint) 
+      do kk=0, nths-1
+        step1: do ii=bnds(kk), bnds(kk+1)-1
+          i = idxs(ii)          
+          if (info /= 0) cycle step1
+          if ((i<1).or.(i>nr)) then
+            !$omp atomic write
+            info=psb_err_internal_error_
+            !$omp end atomic 
+            call psb_errpush(info,name)
+            cycle step1
+            !goto 9999
+          end if
+            
+          if (ilaggr(i) == -(nr+1)) then
+            nz         = (acsr%irp(i+1)-acsr%irp(i))
+            if ((nz<0).or.(nz>size(icol))) then
+              !$omp atomic write
+              info=psb_err_internal_error_
+              !$omp end atomic 
+              call psb_errpush(info,name)
+              cycle step1
+              !goto 9999
+            end if
+
+            icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
+            val(1:nz)  = acsr%val(acsr%irp(i):acsr%irp(i+1)-1) 
+
+            !
+            ! Build the set of all strongly coupled nodes 
+            !
+            ip = 0
+            do k=1, nz
+              j   = icol(k)
+              ! If any of the neighbours is already assigned,
+              ! we will not reset. 
+              if (j>nr) cycle step1
+              if (ilaggr(j) > 0) cycle step1
+              if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.szero)) then
+                ip = ip + 1
+                icol(ip) = icol(k)
+              end if
+            enddo
+            
+            !
+            ! If the whole strongly coupled neighborhood of I is
+            ! as yet unconnected, turn it into the next aggregate.
+            ! Same if ip==0 (in which case, neighborhood only
+            ! contains I even if it does not look like it from matrix)
+            ! The fact that DISJOINT is private and not under lock
+            ! generates a certain un-repeatability, in that between
+            ! computing DISJOINT and assigning, another thread might
+            ! alter the values of ILAGGR.
+            ! However, a certain unrepeatability is already present
+            ! because the sequence of aggregates is computed with a
+            ! different order than in serial mode.
+            ! In any case, even if the enteries of ILAGGR may be
+            ! overwritten, the important thing is that each entry is
+            ! consistent and they generate a correct aggregation map.
+            !
+            disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
+            if (disjoint) then
+              locnaggr(kk)     = locnaggr(kk) + 1
+              itmp = (bnds(kk)-1+locnaggr(kk)) !be careful about overflow
+              itmp = itmp*nths+kk
+              if (itmp < (bnds(kk)-1+locnaggr(kk))) then
+                !$omp atomic update
+                info = max(12345678,info)
+                !$omp end atomic
+                cycle step1
+              end if
+              !$omp atomic write
+              ilaggr(i) = itmp
+              !$omp end atomic
+              do k=1, ip
+                !$omp atomic write
+                ilaggr(icol(k)) = itmp
+                !$omp end atomic
+              end do
+            end if
+          end if
+        enddo step1
+      end do
+      !$omp end do
+
+      !$omp master
+      naggr = sum(locnaggr(0:nths-1))
+      do i=1,nths
+        locnaggr(i) = locnaggr(i) + locnaggr(i-1)
+      end do
+      do i=nths+1,1,-1
+        locnaggr(i) = locnaggr(i-1)
+      end do
+      locnaggr(0) = 0
+      !$omp end master 
+      !$omp barrier
+      !$omp  do schedule(static) 
+      do kk=0, nths-1
+        do ii=bnds(kk), bnds(kk+1)-1
+          if (ilaggr(ii) > 0) then 
+            kp = mod(ilaggr(ii),nths)
+            ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
+          end if
+        end do
+      end do
+      !$omp end do
+    end block
+    !$omp end parallel
+  end block
+  if (info /= 0) then
+    if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
+    info=psb_err_internal_error_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+#else
   step1: do ii=1, nr
+    if (info /= 0) cycle
     i = idxs(ii)
     if ((i<1).or.(i>nr)) then
       info=psb_err_internal_error_
       call psb_errpush(info,name)
-      goto 9999
+      cycle step1
+      !goto 9999
     end if
-    
+
     if (ilaggr(i) == -(nr+1)) then
       nz         = (acsr%irp(i+1)-acsr%irp(i))
       if ((nz<0).or.(nz>size(icol))) then
         info=psb_err_internal_error_
         call psb_errpush(info,name)
-        goto 9999
+        cycle step1
+        !goto 9999
       end if
 
       icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
@@ -176,11 +353,11 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       !
       ! Build the set of all strongly coupled nodes 
       !
-      ip = 0 
+      ip = 0
       do k=1, nz
         j   = icol(k)
         if ((1<=j).and.(j<=nr)) then 
-          if (abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))) then
+          if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.szero)) then
             ip = ip + 1
             icol(ip) = icol(k)
           end if
@@ -194,8 +371,7 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       ! contains I even if it does not look like it from matrix)
       !
       disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
-      if (disjoint) then 
-        icnt      = icnt + 1 
+      if (disjoint) then       
         naggr     = naggr + 1
         do k=1, ip
           ilaggr(icol(k)) = naggr
@@ -204,16 +380,22 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     endif
   enddo step1
-  
+#endif
   if (debug_level >= psb_debug_outer_) then 
     write(debug_unit,*) me,' ',trim(name),&
-         & ' Check 1:',count(ilaggr == -(nr+1))
+         & ' Check   1:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
+         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
   end if
-
+  if (do_timings) call psb_toc(idx_soc1_p1)
+  if (do_timings) call psb_tic(idx_soc1_p2)
   !
   ! Phase two: join the neighbours
   !
+  !$omp workshare
   tmpaggr = ilaggr
+  !$omp end workshare
+  !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,theta)& 
+  !$omp     private(ii,i,j,k,nz,icol,val,ip,cpling)
   step2: do ii=1,nr
     i = idxs(ii)
 
@@ -244,8 +426,15 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     end if
   end do step2
+  !$omp end parallel do
+  if (do_timings) call psb_toc(idx_soc1_p2)
+  if (debug_level >= psb_debug_outer_) then 
+    write(debug_unit,*) me,' ',trim(name),&
+         & ' Check 1.5:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
+         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
+  end if
 
-
+  if (do_timings) call psb_tic(idx_soc1_p3)
   !
   ! Phase three: sweep over leftovers, if any 
   !
@@ -274,7 +463,6 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         end if
       enddo
       if (ip > 0) then
-        icnt      = icnt + 1 
         naggr     = naggr + 1
         ilaggr(i) = naggr
         do k=1, ip
@@ -292,7 +480,10 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   end do step3
 
   ! Any leftovers?
+  !$omp parallel do schedule(static) shared(ilaggr,info)& 
+  !$omp     private(ii,i,j,k,nz,icol,val,ip)
   do i=1, nr
+    if (info /= 0) cycle
     if (ilaggr(i) < 0) then
       nz = (acsr%irp(i+1)-acsr%irp(i))
       if (nz == 1) then
@@ -303,15 +494,18 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         ! other processes. 
         ilaggr(i) = -(nrglob+nr)
       else
+        !$omp atomic write
         info=psb_err_internal_error_
+        !$omp end atomic
         call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
-        goto 9999
+        cycle 
       endif
     end if
   end do
-
+  !$omp end parallel do
+  if (info /= 0) goto 9999
+  if (do_timings) call psb_toc(idx_soc1_p3)
   if (naggr > ncol) then 
-    !write(0,*) name,'Error : naggr > ncol',naggr,ncol
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')
     goto 9999
@@ -336,9 +530,13 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nlaggr(:) = 0
   nlaggr(me+1) = naggr
   call psb_sum(ctxt,nlaggr(1:np))
+  if (debug_level >= psb_debug_outer_) then 
+    write(debug_unit,*) me,' ',trim(name),&
+         & ' Check   2:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
+         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
+  end if
 
   call acsr%free()
-
   call psb_erractionrestore(err_act)
   return
 
@@ -347,4 +545,3 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   return
 
 end subroutine amg_s_soc1_map_bld
-