Merge branch 'repackage' of github.com:sfilippone/amg4psblas into repackage

Fix interface issues of clone_settings
Fix output formatting bug
2026-10-09 23:49:05 +00:00 · 2025-02-09 16:32:40 +01:00 · 2025-02-09 16:02:00 +01:00 · 2025-01-19 11:15:44 +01:00 · 2025-01-08 17:19:58 +01:00 · 2024-12-13 17:19:04 +00:00
368 changed files with 38535 additions and 14255 deletions
@@ -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
@@ -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


@@ -3,9 +3,9 @@ include Make.inc

 all:  objs lib

-objs: amgp cbnd
+objs: libdir amgp cbnd

-lib: libdir objs
+lib:  objs
 	cd amgprec && $(MAKE) lib
 	cd cbind && $(MAKE)  lib

@@ -46,6 +46,7 @@ cleanlib:

 veryclean: cleanlib
 	(cd amgprec && $(MAKE) veryclean)
+	(cd cbind && $(MAKE) veryclean)
 	(cd samples/simple/fileread && $(MAKE) clean)
 	(cd samples/simple/pdegen && $(MAKE) clean)
 	(cd samples/advanced/fileread && $(MAKE) clean)
@@ -56,3 +57,4 @@ check: all

 clean:
 	(cd amgprec && $(MAKE) clean)
+	(cd cbind && $(MAKE) clean)
@@ -1,54 +1,76 @@
-                         AMG4PSBLAS  
- Algebraic Multigrid Package  based on PSBLAS (Parallel Sparse BLAS version 3.8)
-    
-Salvatore Filippone    (University of Rome Tor Vergata and IAC-CNR)
-Pasqua D'Ambra         (IAC-CNR, Naples, IT)
-Fabio Durastante       (IAC-CNR, Naples, IT)
+# AMG4PSBLAS  v1.2
+Algebraic Multigrid Package  based on [PSBLAS](https://github.com/sfilippone/psblas3) (Parallel Sparse BLAS version 3.9)

---------------------------------------------------------------------
+AMG4PSBLAS is a package of parallel algebraic multilevel preconditioners included in the PSCToolkit (Parallel Sparse Computation Toolkit) software framework.

-AMG4PSBLAS is a package of Algebraic MultiGrid (AMG)
-preconditioners for  the iterative solution of large and sparse linear systems.
+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.

-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.
+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](LICENSE.MLD2P4)), but due to the significant number of changes and the increase in scope, we decided to rename the package as AMG4PSBLAS.

-MAIN REFERENCES:
+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.

-     
+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.

-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.
+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.

+## Main Refrerences:

-TO COMPILE
+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.
+
+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.

+### 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
@@ -9,21 +9,21 @@ 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 \
 	amg_d_invk_solver.o amg_d_invt_solver.o amg_d_krm_solver.o \
-	amg_d_matchboxp_mod.o amg_d_parmatch_aggregator_mod.o \
-        amg_d_newmatch_aggregator_mod.o amg_d_decmatch_mod.o
+	amg_d_matchboxp_mod.o amg_d_parmatch_aggregator_mod.o

 SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \
 	amg_s_inner_mod.o amg_s_ilu_solver.o amg_s_diag_solver.o amg_s_jac_smoother.o amg_s_as_smoother.o \
-	amg_s_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 \
@@ -34,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 \
@@ -44,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 \
@@ -117,7 +117,7 @@ amg_c_prec_type.o: amg_c_onelev_mod.o
 amg_z_prec_type.o: amg_z_onelev_mod.o

 amg_s_onelev_mod.o: amg_s_base_smoother_mod.o amg_s_dec_aggregator_mod.o amg_s_parmatch_aggregator_mod.o 
-amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o amg_d_parmatch_aggregator_mod.o amg_d_newmatch_aggregator_mod.o
+amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o amg_d_parmatch_aggregator_mod.o 
 amg_c_onelev_mod.o: amg_c_base_smoother_mod.o amg_c_dec_aggregator_mod.o
 amg_z_onelev_mod.o: amg_z_base_smoother_mod.o amg_z_dec_aggregator_mod.o

@@ -130,8 +130,6 @@ amg_d_base_aggregator_mod.o: amg_base_prec_type.o
 amg_d_parmatch_aggregator_mod.o amg_d_dec_aggregator_mod.o: amg_d_base_aggregator_mod.o
 amg_d_hybrid_aggregator_mod.o amg_d_symdec_aggregator_mod.o: amg_d_dec_aggregator_mod.o
 amg_d_parmatch_aggregator_mod.o: amg_d_matchboxp_mod.o 
-amg_d_newmatch_aggregator_mod.o: amg_d_base_aggregator_mod.o
-amg_d_newmatch_aggregator_mod.o: amg_d_decmatch_mod.o

 amg_c_base_aggregator_mod.o: amg_base_prec_type.o
 amg_c_parmatch_aggregator_mod.o amg_c_dec_aggregator_mod.o: amg_c_base_aggregator_mod.o
@@ -158,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
@@ -167,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
@@ -179,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
@@ -189,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
@@ -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
@@ -275,8 +277,7 @@ module amg_base_prec_type
  integer(psb_ipk_), parameter :: amg_sym_dec_aggr_  = 1
  integer(psb_ipk_), parameter :: amg_ext_aggr_      = 2
  integer(psb_ipk_), parameter :: amg_coupled_aggr_  = 3
-  integer(psb_ipk_), parameter :: amg_newmtc_aggr_   = 4
-  integer(psb_ipk_), parameter :: amg_max_par_aggr_alg_  = amg_newmtc_aggr_
+  integer(psb_ipk_), parameter :: amg_max_par_aggr_alg_  = amg_coupled_aggr_
  !
  ! Legal values for entry: amg_aggr_type_
  !
@@ -284,21 +285,22 @@ module amg_base_prec_type
  integer(psb_ipk_), parameter :: amg_soc1_        = 1
  integer(psb_ipk_), parameter :: amg_soc2_        = 2
  integer(psb_ipk_), parameter :: amg_matchboxp_   = 3
-  integer(psb_ipk_), parameter :: amg_newmatch_    = 4
  !
  ! 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_
  !
@@ -320,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_
  !
@@ -366,21 +378,21 @@ 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 :: &
-       &  aggr_type_names(0:4)=(/'None              ',&
+       &  aggr_type_names(0:3)=(/'None              ',&
       &  'SOC measure 1     ', 'SOC Measure 2     ',&
-       &  'Parallel Matching ','Decoupled Matching'/)
+       &  'Parallel Matching '/)
  character(len=18), parameter, private :: &
-       &  par_aggr_alg_names(0:4)=(/&
+       &  par_aggr_alg_names(0:3)=(/&
       & 'decoupled aggr.   ', 'sym. dec. aggr.   ',&
-       & 'user defined aggr.', 'coupled aggr.     ',&
-       & 'new matching aggr.'/)
+       & 'user defined aggr.', 'coupled aggr.     '/)
  character(len=18), parameter, private :: &
       &  ord_names(0:1)=(/'Natural ordering  ','Desc. degree ord. '/)
  character(len=6), parameter, private :: &
@@ -392,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    ',&
@@ -459,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')
@@ -484,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')
@@ -519,10 +531,6 @@ contains
      val = amg_soc2_
    case('SOC1')
      val = amg_soc1_
-    case('NEWMATCH')
-      val = amg_newmatch_
-    case('NEWMTC')
-      val = amg_newmtc_aggr_
    case('MATCHBOXP','PARMATCH')
      val = amg_matchboxp_
    case('COUPLED','COUP')
@@ -543,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')
@@ -563,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')
@@ -571,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')
@@ -584,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
@@ -646,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

@@ -1015,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)
@@ -58,6 +58,7 @@ 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
@@ -85,6 +86,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)
@@ -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)
@@ -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(:)
@@ -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, &
@@ -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, &
@@ -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
@@ -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
@@ -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
@@ -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, &
@@ -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


  !
@@ -58,6 +58,7 @@ 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
@@ -85,6 +86,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)
@@ -1,529 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-module amg_d_decmatch_mod
-
-  use iso_c_binding
-  use psb_base_cbind_mod
-
-  interface new_Match_If
-    function dnew_Match_If(ipar,matching,lambda,nr, irp, ja, val, diag, w, mate) &
-         & bind(c,name="dnew_Match_If") result(res)
-      use iso_c_binding
-      import :: psb_c_ipk_, psb_c_lpk_, psb_c_mpk_, psb_c_epk_
-      implicit none
-
-      integer(psb_c_ipk_) :: res
-      integer(psb_c_ipk_), value :: nr,ipar,matching
-      real(c_double), value :: lambda      
-      type(c_ptr), value :: irp, ja, mate
-      type(c_ptr), value :: val, diag, w 
-    end function dnew_Match_If
-  end interface new_Match_If
-
-  interface amg_build_decmatch
-    module procedure amg_dbuild_decmatch
-  end interface amg_build_decmatch
-
-  logical, parameter, private :: print_statistics=.false.
-contains
-
-  subroutine amg_ddecmatch_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
-       & symmetrize,reproducible,display_inp, display_out, print_out, &
-       & parallel, matching,lambda)
-    use psb_base_mod
-    use psb_util_mod
-    use iso_c_binding
-    implicit none
-    real(psb_dpk_), allocatable, intent(inout)  :: w(:)
-    type(psb_dspmat_type), intent(inout)        :: a
-    type(psb_desc_type)                         :: desc_a
-    integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:)
-    integer(psb_lpk_), allocatable, intent(out) :: nlaggr(:)
-    type(psb_ldspmat_type), intent(out)         :: prol
-    integer(psb_ipk_), intent(out)              :: info
-    logical, optional, intent(in)               :: display_inp, display_out, reproducible
-    logical, optional, intent(in)               :: symmetrize, print_out, parallel
-    integer(psb_ipk_), optional, intent(in)     :: matching
-    real(psb_dpk_), optional, intent(in)        :: lambda
-
-    !
-    !
-    type(psb_ctxt_type) :: ictxt
-    integer(psb_ipk_) :: iam, np, iown
-    integer(psb_ipk_) :: nr, nc, sweep, nzl, ncsave, nct, idx
-    integer(psb_lpk_) :: i, k, kg, idxg, ntaggr, naggrm1, naggrp1, &
-         & ip, nlpairs, nlsingl, nunmatched, lnr
-    real(psb_dpk_)    :: wk, widx, wmax, nrmagg
-    real(psb_dpk_), allocatable    :: wtemp(:)
-    integer(psb_ipk_), allocatable :: mate(:)
-    integer(psb_lpk_), allocatable ::  ilv(:)
-    integer(psb_ipk_), save     :: cnt=1
-    character(len=256)          :: aname
-    type(psb_ld_coo_sparse_mat) :: tmpcoo
-    logical  :: display_out_, print_out_, reproducible_, parallel_
-    integer(psb_ipk_) :: matching_
-    real(psb_dpk_)    :: lambda_    
-    logical, parameter  :: dump=.false., debug=.false., dump_mate=.false., &
-         & debug_ilaggr=.false., debug_sync=.false.
-    integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
-    logical, parameter :: do_timings=.true.
-
-    ictxt = desc_a%get_ctxt()
-    call psb_info(ictxt,iam,np)
-
-    if ((do_timings).and.(idx_phase1==-1))       &
-         & idx_phase1 = psb_get_timer_idx("MBP_BLDP: phase1       ")
-    if ((do_timings).and.(idx_bldmtc==-1))       &
-         & idx_bldmtc = psb_get_timer_idx("MBP_BLDP: buil_matching")
-    if ((do_timings).and.(idx_phase2==-1))       &
-         & idx_phase2 = psb_get_timer_idx("MBP_BLDP: phase2       ")
-    if ((do_timings).and.(idx_phase3==-1))       &
-         & idx_phase3 = psb_get_timer_idx("MBP_BLDP: phase3       ")
-
-    if (do_timings) call psb_tic(idx_phase1)
-
-    if (present(display_out)) then
-      display_out_ = display_out
-    else
-      display_out_ = .false.
-    end if
-    if (present(print_out)) then
-      print_out_ = print_out
-    else
-      print_out_ = .false.
-    end if
-    if (present(reproducible)) then
-      reproducible_ = reproducible
-    else
-      reproducible_ = .false.
-    end if
-
-    if (present(parallel)) then
-      parallel_ = parallel
-    else
-      parallel_ = .true.
-    end if
-
-    if (present(matching)) then
-      matching_ = matching
-    else
-      matching_ = 2
-    end if
-
-    if (present(lambda)) then
-      lambda_ = lambda
-    else
-      lambda_ = 2.0
-    end if
-
-    allocate(nlaggr(0:np-1),stat=info)
-    if (info /= 0) then
-      return
-    end if
-
-    nlaggr = 0
-    ilv    = [(i,i=1,desc_a%get_local_cols())]
-    call desc_a%l2gip(ilv,info,owned=.false.)
-
-    call psb_geall(ilaggr,desc_a,info)
-    ilaggr = -1
-    call psb_geasb(ilaggr,desc_a,info)
-    nr = a%get_nrows()
-    nc = a%get_ncols()
-    if (size(w) < nc) then
-      call psb_realloc(nc,w,info)
-    end if
-    call psb_halo(w,desc_a,info)
-
-    if (debug) write(0,*) iam,' buildprol into buildmatching:',&
-         & nr, nc
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (iam == 0) write(0,*)' buildprol into buildmatching:',&
-           & nr, nc
-    end if
-    if (do_timings) call psb_toc(idx_phase1)
-    if (do_timings) call psb_tic(idx_bldmtc)
-    call amg_dbuild_decmatch(parallel_,matching_,lambda_,w,a,desc_a,mate,info)
-    if (do_timings) call psb_toc(idx_bldmtc)
-    if (debug) write(0,*) iam,' buildprol from buildmatching:',&
-         & info
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (iam == 0) write(0,*)' out from buildmatching:', info
-    end if
-
-    if (info == 0) then
-      if (do_timings) call psb_tic(idx_phase2)
-      if (debug_sync) then
-        call psb_barrier(ictxt)
-        if (iam == 0) write(0,*)' Into building the tentative prol:'
-      end if
-
-      call psb_geall(wtemp,desc_a,info)
-      wtemp      = dzero
-      call psb_geasb(wtemp,desc_a,info)
-
-      nlaggr(iam) = 0
-      nlpairs    = 0
-      nlsingl    = 0
-      nunmatched = 0
-      !
-      ! First sweep
-      ! On return from build_matching, mate has been converted to local numbering,
-      ! so assigning to idx is OK.
-      !
-      do k=1, nr
-        idx = mate(k)
-        !
-        ! Figure out an allocation of aggregates to processes
-        !
-        if (idx < 0) then
-          !
-          !  Unmatched vertex, potential  singleton.
-          !
-          nunmatched = nunmatched + 1
-          if (abs(w(k))<epsilon(nrmagg)) then
-            ! Keep it unaggregated
-            wtemp(k) = dzero
-          else
-            ! Create a singleton aggregate
-            nlaggr(iam) = nlaggr(iam) + 1
-            ilaggr(k)   = nlaggr(iam)
-            wtemp(k)    = w(k)/abs(w(k))
-            nlsingl     = nlsingl + 1
-          end if
-!!$          write(0,*) k,mate(k),ilaggr(k),' negative match ',abs(w(k)), epsilon(nrmagg)
-        else  if (idx > nc) then
-          write(0,*) 'Impossible: mate(k) > nc'
-          cycle
-        else
-
-          if (ilaggr(k) == -1) then
-
-            wk   = w(k)
-            widx = w(idx)
-            wmax = max(abs(wk),abs(widx))
-            nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
-            if (nrmagg > epsilon(nrmagg)) then
-              if (idx <= nr) then
-                if (ilaggr(idx) == -1) then
-                  ! Now, if both vertices are local, the aggregate is local
-                  ! (kinda obvious).
-                  nlaggr(iam) = nlaggr(iam) + 1
-                  ilaggr(k)   = nlaggr(iam)
-                  ilaggr(idx) = nlaggr(iam)
-                  wtemp(k)    = w(k)/nrmagg
-                  wtemp(idx)  = w(idx)/nrmagg
-                end if
-                nlpairs = nlpairs+1
-              else
-                write(0,*) 'Really?  mate(k) > nr? ',mate(k),nr
-              end if
-            else
-              if (abs(w(k))<epsilon(nrmagg)) then
-                ! Keep it unaggregated
-                wtemp(k) = dzero
-              else
-                ! Create a singleton aggregate
-                nlaggr(iam) = nlaggr(iam) + 1
-                ilaggr(k)   = nlaggr(iam)
-                wtemp(k)    = w(k)/abs(w(k))
-                nlsingl     = nlsingl + 1
-              end if
-            end if
-          end if
-        end if
-      end do
-      if (do_timings) call psb_toc(idx_phase2)
-      if (do_timings) call psb_tic(idx_phase3)
-
-      ! Ok, now compute offsets, gather halo and fix non-local
-      ! aggregates  (those where ilaggr == -2)
-      call psb_sum(ictxt,nlaggr)
-      ntaggr  = sum(nlaggr(0:np-1))
-      naggrm1 = sum(nlaggr(0:iam-1))
-      naggrp1 = sum(nlaggr(0:iam))
-      !
-      ! Shift all indices already assigned (i.e. >0)
-      !
-      do k=1,nr
-        if (ilaggr(k) > 0) then
-          ilaggr(k) = ilaggr(k) + naggrm1
-!!$        else
-!!$          write(0,*) 'Leftover ILAGGR',k,ilaggr(k),mate(k),abs(w(k)),epsilon(nrmagg)
-        end if
-      end do
-      call psb_halo(ilaggr,desc_a,info)
-      call psb_halo(wtemp,desc_a,info)
-      ! Cleanup as yet unmarked entries
-      do k=1,nr
-        if (ilaggr(k) == -2) then
-          idx = mate(k)
-          if (idx > nr) then
-            i   = ilaggr(idx)
-            if (i > 0) then
-              ilaggr(k) = i
-            else
-              write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
-            end if
-          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,*) 'Decmatch: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
-        end if
-      end do
-      if (debug_sync) then
-        call psb_barrier(ictxt)
-        if (iam == 0) write(0,*)' Done building the tentative prol:'
-      end if
-
-
-      if (dump_mate) then
-        block
-          integer(psb_lpk_), allocatable :: glaggr(:)
-          write(aname,'(a,i3.3,a,i3.3,a)') 'mateg-',cnt,'-p',iam,'.mtx'
-          open(20,file=aname)
-          write(20,'(a,I3,a)') '% sparse vector on process ',iam,' '
-          do k=1, nr
-            write(20,'(3(I8,1X))') ilv(k),ilv(mate(k))
-          end do
-          close(20)
-          write(aname,'(a,i3.3,a,i3.3,a)') 'nloc-',cnt,'-p',iam,'.mtx'
-          open(20,file=aname)
-          write(20,'(a,I3,a)') '% sparse vector on process ',iam,' '
-          write(20,'(a,I12,a)') 'nlpairs ',nlpairs
-          write(20,'(a,I12,a)') 'nlsingl ',nlsingl
-          write(20,'(a,I12,a)') 'nlaggr(iam) ',nlaggr(iam)
-          close(20)
-          write(aname,'(a,i3.3,a,i3.3,a,i3.3,a)') 'ilaggr-',cnt,'-i',iam,'-p',np,'.mtx'
-          open(20,file=aname)
-          write(20,'(a,I3,a)') '% sparse vector on process ',iam,' '
-          do k=1, nr
-            write(20,'(3(I8,1X))') ilv(k),ilaggr(k)
-          end do
-          close(20)
-
-          write(aname,'(a,i3.3,a,i3.3,a)') 'glaggr-',cnt,'-p',np,'.mtx'
-          call psb_gather(glaggr,ilaggr,desc_a,info,root=izero)
-          if (iam==0) call mm_array_write(glaggr,'Aggregates ',info,filename=aname)
-
-          cnt=cnt+1
-        end block
-      end if
-      block
-        integer(psb_lpk_) :: v(3)
-        v(1) = nunmatched
-        v(2) = nlsingl
-        v(3) = nlpairs
-        call psb_sum(ictxt,v)
-        nunmatched = v(1)
-        nlsingl    = v(2)
-        nlpairs    = v(3)
-
-      end block
-      if (print_statistics) then
-        if (iam == 0) then
-          write(0,*) 'Matching statistics: Unmatched nodes ',&
-               & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
-        end if
-      end if
-      
-      if (display_out_) then
-        block
-          integer(psb_ipk_) :: idx
-          !
-          !  And finally print out
-          !
-          do i=0,np-1
-            call psb_barrier(ictxt)
-            if (iam == i) then
-              write(0,*) 'Process ', iam,' hosts aggregates:  (',naggrm1+1,' : ',naggrp1-1,')'
-              do k=1, nr
-                idx  = mate(k)
-                kg    = ilv(k)
-                if (idx >0) then
-                  idxg  = ilv(idx)
-                else
-                  idxg = -1
-                end if
-                if (idx < 0) then
-                  write(0,*) kg,': singleton   (',kg,' ( Proc',iam,') ) into aggregate => ', ilaggr(k)
-                else if (idx <= nr) then
-                  write(0,*) kg,': paired with (',idxg,' ( Proc',iam,') ) into aggregate => ', ilaggr(k)
-                else
-                  call desc_a%indxmap%qry_halo_owner(idx,iown,info)
-                  write(0,*) kg,': paired with (',idxg,' ( Proc',iown,') ) into aggregate => ', ilaggr(k)
-                end if
-              end do
-              flush(0)
-            end if
-          end do
-        end block
-      end if
-
-      ! Dirty trick: allocate tmpcoo with local
-      ! number of aggregates, then change to ntaggr.
-      ! Just to make sure the allocation is not global
-      lnr = nr
-      call tmpcoo%allocate(lnr,nlaggr(iam),lnr)
-      k = 0
-      do i=1,nr
-        !
-        ! Note: at this point, a value ilaggr(i)<=0
-        ! tags an unaggregated row, and it has to be
-        ! left alone (i.e.: it should stay at fine level only)
-        !
-        if (ilaggr(i)>0) then
-          k = k + 1
-          tmpcoo%val(k) = wtemp(i)
-          tmpcoo%ia(k)  = i
-          tmpcoo%ja(k)  = ilaggr(i)
-        end if
-      end do
-      call tmpcoo%set_nzeros(k)
-      call tmpcoo%set_dupl(psb_dupl_add_)
-      call tmpcoo%set_sorted() ! This is now in row-major
-
-      if (display_out_) then
-        call psb_barrier(ictxt)
-        flush(0)
-
-        if (iam == 0) write(0,*) 'Prolongator: '
-        flush(0)
-        do i=0,np-1
-          call psb_barrier(ictxt)
-          if (iam == i) then
-            do k=1, nr
-              write(0,*) ilv(tmpcoo%ia(k)),tmpcoo%ja(k), tmpcoo%val(k)
-            end do
-            flush(0)
-          end if
-        end do
-      end if
-
-      call prol%mv_from(tmpcoo)
-      if (do_timings) call psb_toc(idx_phase3)
-
-      if (print_out_) then
-        write(aname,'(a,i3.3,a)') 'prol-g-',iam,'.mtx'
-        call prol%print(fname=aname,head='Test ',ivr=ilv)
-        write(aname,'(a,i3.3,a)') 'prol-',iam,'.mtx'
-        call prol%print(fname=aname,head='Test ')
-      end if
-
-    else
-      write(0,*) iam,' :  error from Matching: ',info
-    end if
-
-  end subroutine amg_ddecmatch_build_prol
-
-  subroutine amg_dbuild_decmatch(parallel,matching,lambda,w,a,desc_a,mate,info)
-    use psb_base_mod
-    use psb_util_mod
-    use iso_c_binding
-    implicit none
-    logical, intent(in)               :: parallel
-    integer(psb_ipk_), intent(in)     :: matching
-    real(psb_dpk_), intent(in)        :: lambda
-    real(psb_dpk_), target                      :: w(:)
-    type(psb_dspmat_type), intent(inout)        :: a
-    type(psb_desc_type)                         :: desc_a
-    integer(psb_ipk_), allocatable, intent(out), target :: mate(:)
-    integer(psb_ipk_), intent(out)              :: info
-
-    type(psb_d_csr_sparse_mat), target :: tcsr
-    real(psb_dpk_), allocatable, target :: diag(:)
-    real(psb_dpk_) :: ph0t,ph1t,ph2t
-    type(psb_ctxt_type) :: ictxt
-    integer(psb_ipk_) :: iam, np
-    integer(psb_ipk_)  :: nr, nc, nz, i, nunmatch, ipar 
-    integer(psb_ipk_), save :: cnt=2
-    logical, parameter :: debug=.false., dump_ahat=.false., debug_sync=.false.
-    logical, parameter :: old_style=.false., sort_minp=.true.
-    character(len=40) :: name='build_matching', fname
-    integer(psb_ipk_), save :: idx_cmboxp=-1, idx_bldahat=-1, idx_phase2=-1, idx_phase3=-1
-    logical, parameter :: do_timings=.true.
-
-    ictxt = desc_a%get_ctxt()
-    call psb_info(ictxt,iam,np)
-
-    nr = a%get_nrows()
-    call a%cp_to(tcsr)
-    call psb_realloc(nr,mate,info)
-    diag = a%get_diag(info)
-    if (parallel) then
-      ipar = 2
-    else
-      ipar = 1
-    end if
-    !
-    ! Now call matching!
-    !
-    if (debug) write(0,*) iam,' buildmatching into NewMatch:'
-    if (do_timings) call psb_tic(idx_cmboxp)
-    info = dnew_Match_If(ipar,matching,lambda,nr,c_loc(tcsr%irp),c_loc(tcsr%ja),&
-         & c_loc(tcsr%val),c_loc(diag),c_loc(w),c_loc(mate))
-    if (do_timings) call psb_toc(idx_cmboxp)
-    if (debug) write(0,*) iam,' buildmatching from NewMatch:', info
-    if (debug_sync) then
-      call psb_max(ictxt,info)
-      if (iam == 0) write(0,*)' done NewMatch', info
-    end if
-
-    if (do_timings) call psb_tic(idx_phase3)
-    nunmatch = count(mate(1:nr)<=0)
-        ! call psb_sum(ictxt,nunmatch)
-    !if (nunmatch /= 0) write(0,*) iam,' Unmatched nodes local imbalance ',nunmatch
-    !    if (count(mate(1:nr)<0) /= nunmatch) write(0,*) iam,' Matching results ?',&
-    !        & nunmatch, count(mate(1:nr)<0)
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (iam == 0) write(0,*)' done build_matching '
-    end if
-
-    if (do_timings) call psb_toc(idx_phase3)
-    return
-
-9999 continue
-    call psb_error(ictxt)
-
-  end subroutine amg_dbuild_decmatch
-
-end module amg_d_decmatch_mod
@@ -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)
@@ -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(:)
@@ -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, &
@@ -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, &
@@ -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
@@ -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
@@ -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
@@ -1,585 +0,0 @@
-!
-!
-!  The aggregator object hosts the aggregation method for building
-!  the multilevel hierarchy. This variant is based on the hybrid method
-!  presented in 
-!
-!
-!   sm           -  class(amg_T_base_smoother_type), allocatable
-!                   The current level preconditioner (aka smoother).
-!   parms        -  type(amg_RTml_parms)
-!                   The parameters defining the multilevel strategy.
-!   ac           -  The local part of the current-level matrix, built by
-!                   coarsening the previous-level matrix.
-!   desc_ac      -  type(psb_desc_type).
-!                   The communication descriptor associated to the matrix
-!                   stored in ac.
-!   base_a       -  type(psb_Tspmat_type), pointer.
-!                   Pointer (really a pointer!) to the local part of the current 
-!                   matrix (so we have a unified treatment of residuals).
-!                   We need this to avoid passing explicitly the current matrix
-!                   to the routine which applies the preconditioner.
-!   base_desc    -  type(psb_desc_type), pointer.
-!                   Pointer to the communication descriptor associated to the
-!                   matrix pointed by base_a.
-!   map          -  Stores the maps (restriction and prolongation) between the
-!                   vector spaces associated to the index spaces of the previous
-!                   and current levels.
-!
-!   Methods:  
-!     Most methods follow the encapsulation hierarchy: they take whatever action
-!     is appropriate for the current object, then call the corresponding method for
-!     the contained object.
-!     As an example: the descr() method prints out a description of the
-!     level. It starts by invoking the descr() method of the parms object,
-!     then calls the descr() method of the smoother object. 
-!
-!    descr      -   Prints a description of the object.
-!    default    -   Set default values
-!    dump       -   Dump to file object contents
-!    set        -   Sets various parameters; when a request is unknown
-!                   it is passed to the smoother object for further processing.
-!    check      -   Sanity checks.
-!    sizeof     -   Total memory occupation in bytes
-!    get_nzeros -   Number of nonzeros 
-!
-!
-
-module amg_d_newmatch_aggregator_mod
-  use amg_d_base_aggregator_mod
-  use iso_c_binding
-  
-  type, bind(c)::  nwm_Vector
-    type(c_ptr) :: data
-    integer(c_int) :: size
-    integer(c_int) :: owns_data
-  end type nwm_Vector
-  
-  type, bind(c)::  nwm_CSRMatrix
-    type(c_ptr) :: i
-    type(c_ptr) :: j
-    integer(c_int) :: num_rows
-    integer(c_int) :: num_cols
-    integer(c_int) :: num_nonzeros
-    integer(c_int) :: owns_data
-    type(c_ptr) :: data
-  end type nwm_CSRMatrix
-  
-  type, extends(amg_d_base_aggregator_type) :: amg_d_newmatch_aggregator_type
-    integer(psb_ipk_) :: matching_alg
-    integer(psb_ipk_) :: n_sweeps
-    !
-    !  Note: the BootCMatch kernel we invoke  overwrites
-    !  the W argument with its update. Hence, copy it in w_nxt
-    !  before passing it to the matching
-    !
-    integer(psb_ipk_) :: orig_aggr_size
-    integer(psb_ipk_) :: jacobi_sweeps
-    real(psb_dpk_), allocatable :: w(:), w_nxt(:)
-    type(psb_dspmat_type), allocatable  :: prol, restr
-    type(psb_dspmat_type), allocatable  :: ac, base_a, rwa
-    type(psb_desc_type), allocatable    :: desc_ac, desc_ax, base_desc, rwdesc
-    type(nwm_Vector)  :: w_c_nxt
-    integer(psb_ipk_) :: max_csize
-    integer(psb_ipk_) :: max_nlevels
-    real(psb_dpk_)    :: lambda
-    logical           :: reproducible_matching = .false.
-    logical           :: need_symmetrize       = .false.
-    logical           :: unsmoothed_hierarchy  = .true.
-    logical           :: parallel_matching     = .true. 
-  contains
-    procedure, pass(ag) :: bld_tprol    => amg_d_newmatch_aggregator_build_tprol
-    procedure, pass(ag) :: csetc        => amg_d_newmatch_aggr_csetc
-    procedure, pass(ag) :: csetr        => amg_d_newmatch_aggr_csetr
-    procedure, pass(ag) :: cseti        => d_newmatch_aggr_cseti
-    procedure, pass(ag) :: default      => d_newmatch_aggr_set_default
-    procedure, pass(ag) :: mat_asb      => amg_d_newmatch_aggregator_mat_asb
-    procedure, pass(ag) :: mat_bld      => amg_d_newmatch_aggregator_mat_bld
-    procedure, pass(ag) :: inner_mat_asb => amg_d_newmatch_aggregator_inner_mat_asb
-    procedure, pass(ag) :: update_next  => d_newmatch_aggregator_update_next
-    procedure, pass(ag) :: bld_wnxt     => d_newmatch_bld_wnxt
-    procedure, pass(ag) :: bld_default_w    => d_bld_default_w
-    procedure, pass(ag) :: set_c_default_w  => d_set_default_nwm_w
-    procedure, pass(ag) :: descr        => d_newmatch_aggregator_descr
-    procedure, pass(ag) :: clone        => d_newmatch_aggregator_clone
-    procedure, pass(ag) :: free         => d_newmatch_aggregator_free
-    procedure, nopass   :: fmt          => d_newmatch_aggregator_fmt
-  end type amg_d_newmatch_aggregator_type
-
-
-  interface
-    subroutine  amg_d_newmatch_aggregator_build_tprol(ag,parms,ag_data,&
-         & a,desc_a,ilaggr,nlaggr,t_prol,info)
-      import :: amg_d_newmatch_aggregator_type, psb_desc_type, &
-           & psb_dspmat_type, psb_ldspmat_type, psb_dpk_,  &
-           & psb_ipk_, psb_lpk_, psb_epk_, amg_dml_parms, amg_daggr_data
-      implicit none
-      class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
-      type(amg_dml_parms), intent(inout)   :: parms 
-      type(amg_daggr_data), intent(in)     :: ag_data
-      type(psb_dspmat_type), intent(inout) :: a
-      type(psb_desc_type), intent(inout)   :: desc_a
-      integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
-      type(psb_ldspmat_type), intent(out)  :: t_prol
-      integer(psb_ipk_), intent(out)      :: info
-    end subroutine amg_d_newmatch_aggregator_build_tprol
-  end interface
-
-  interface
-    subroutine  amg_d_newmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_d_newmatch_aggregator_type, psb_desc_type, &
-           & psb_dspmat_type, psb_ldspmat_type, psb_dpk_,  &
-           & psb_ipk_, psb_lpk_, psb_epk_, amg_dml_parms
-      implicit none
-      class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
-      type(amg_dml_parms), intent(inout)    :: parms 
-      type(psb_dspmat_type), intent(in)     :: a
-      type(psb_desc_type), intent(inout)    :: desc_a
-      integer(psb_lpk_), intent(inout)      :: ilaggr(:), nlaggr(:)
-      type(psb_dspmat_type), intent(out)    :: op_prol,ac,op_restr
-      type(psb_ldspmat_type), intent(inout) :: t_prol
-      type(psb_desc_type), intent(inout)    :: desc_ac
-      integer(psb_ipk_), intent(out)        :: info
-    end subroutine amg_d_newmatch_aggregator_mat_bld
-  end interface
-
-  interface
-    subroutine  amg_d_newmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
-         & ac,desc_ac, op_prol,op_restr,info)
-      import :: amg_d_newmatch_aggregator_type, psb_desc_type, &
-           & psb_dspmat_type, psb_ldspmat_type, psb_dpk_,  &
-           & psb_ipk_, psb_lpk_, psb_epk_, amg_dml_parms
-      implicit none
-      class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
-      type(amg_dml_parms), intent(inout)    :: parms 
-      type(psb_dspmat_type), intent(in)     :: a
-      type(psb_desc_type), intent(inout)    :: desc_a
-      type(psb_dspmat_type), intent(inout) :: op_prol,ac,op_restr
-      type(psb_desc_type), intent(inout)     :: desc_ac
-      integer(psb_ipk_), intent(out)        :: info
-    end subroutine amg_d_newmatch_aggregator_mat_asb
-  end interface  
-  
-
-  interface
-    subroutine amg_d_newmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr, op_prol,info)
-      import :: amg_d_newmatch_aggregator_type, psb_desc_type, &
-           & psb_dspmat_type, psb_ldspmat_type, psb_dpk_,  &
-           & psb_ipk_, psb_lpk_, psb_epk_, amg_dml_parms
-      implicit none
-      type(psb_desc_type), intent(in)    :: desc_a
-      integer(psb_lpk_), allocatable, intent(inout)  :: ilaggr(:),nlaggr(:)
-      real(psb_dpk_), allocatable, intent(inout)  :: valaggr(:)
-      type(psb_ldspmat_type), intent(out)  :: op_prol
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_d_newmatch_map_to_tprol
-  end interface
-  
-  interface
-    subroutine amg_daggrmat_unsmth_spmm_asb(a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,op_prol,op_restr,info)
-      import :: amg_d_newmatch_aggregator_type, psb_desc_type, &
-           & psb_dspmat_type, psb_ldspmat_type, psb_dpk_,  &
-           & psb_ipk_, psb_lpk_, psb_epk_, amg_dml_parms
-      implicit none
-      type(psb_dspmat_type), intent(in)        :: a
-      type(psb_desc_type), intent(in)            :: desc_a
-      integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
-      type(amg_dml_parms), intent(inout)      :: parms 
-      type(psb_ldspmat_type), intent(inout)     :: op_prol
-      type(psb_ldspmat_type), intent(out)       :: ac,op_restr
-      integer(psb_ipk_), intent(out)             :: info
-    end subroutine amg_daggrmat_unsmth_spmm_asb
-  end interface
-
-  interface
-    subroutine  amg_d_newmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
-         & ac,desc_ac, op_prol,op_restr,info)
-      import :: amg_d_newmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
-           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
-      implicit none
-      class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
-      type(amg_dml_parms), intent(inout)    :: parms
-      type(psb_dspmat_type), intent(in)     :: a
-      type(psb_desc_type), intent(in)       :: desc_a
-      type(psb_dspmat_type), intent(inout) :: op_prol,op_restr
-      type(psb_dspmat_type), intent(inout)  :: ac
-      type(psb_desc_type), intent(inout)    :: desc_ac
-      integer(psb_ipk_), intent(out)        :: info
-    end subroutine amg_d_newmatch_aggregator_inner_mat_asb
-  end interface
-
-  
-!!$  interface
-!!$    subroutine amg_d_newmatch_unsmth_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
-!!$         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-!!$      import :: amg_d_newmatch_aggregator_type, psb_desc_type, &
-!!$           & psb_dspmat_type, psb_ldspmat_type, psb_dpk_,  &
-!!$           & psb_ipk_, psb_lpk_, psb_epk_, amg_dml_parms
-!!$      
-!!$      implicit none
-!!$      
-!!$      ! Arguments
-!!$      type(psb_dspmat_type), intent(in)        :: a
-!!$      type(psb_desc_type), intent(in)            :: desc_a
-!!$      integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
-!!$      type(amg_dml_parms), intent(inout)      :: parms 
-!!$      type(psb_ldspmat_type), intent(inout)     :: t_prol
-!!$      type(psb_dspmat_type), intent(inout)       :: op_prol,ac,op_restr
-!!$      type(psb_desc_type), intent(inout)    :: desc_ac
-!!$      integer(psb_ipk_), intent(out)             :: info
-!!$    end subroutine amg_d_newmatch_unsmth_spmm_bld
-!!$  end interface
-
-  interface
-    subroutine amg_d_newmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_d_newmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
-           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
-      implicit none
-      type(psb_dspmat_type), intent(inout)    :: a
-      type(psb_desc_type), intent(inout)       :: desc_a
-      integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-      type(amg_dml_parms), intent(inout)      :: parms
-      type(psb_ldspmat_type), intent(inout)   :: t_prol
-      type(psb_dspmat_type), intent(inout)    :: op_prol,ac, op_restr
-      type(psb_desc_type), intent(out)          :: desc_ac
-      integer(psb_ipk_), intent(out)          :: info
-    end subroutine amg_d_newmatch_spmm_bld_ov
-  end interface
-
-  interface
-    subroutine amg_d_newmatch_spmm_bld_inner(a,desc_a,ilaggr,nlaggr,parms,&
-         & ac,desc_ac,op_prol,op_restr,t_prol,info)
-      import :: amg_d_newmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
-           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data,&
-           & psb_d_csr_sparse_mat, psb_ld_csr_sparse_mat
-      implicit none
-      type(psb_d_csr_sparse_mat), intent(inout) :: a
-      type(psb_desc_type), intent(inout)          :: desc_a
-      integer(psb_lpk_), intent(inout)          :: ilaggr(:), nlaggr(:)
-      type(amg_dml_parms), intent(inout)        :: parms
-      type(psb_ldspmat_type), intent(inout)     :: t_prol
-      type(psb_dspmat_type), intent(inout)      :: op_prol,ac, op_restr
-      type(psb_desc_type), intent(out)          :: desc_ac
-      integer(psb_ipk_), intent(out)            :: info
-    end subroutine amg_d_newmatch_spmm_bld_inner
-  end interface
-  
-  private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels
-  
-
-contains
-
-  subroutine d_bld_default_w(ag,nr)
-    use psb_realloc_mod
-    implicit none 
-    class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
-    integer(psb_ipk_), intent(in) :: nr
-    integer(psb_ipk_) :: info
-    call psb_realloc(nr,ag%w,info)
-    if (info /= psb_success_) return
-    ag%w = done
-    call ag%set_c_default_w()
-  end subroutine d_bld_default_w
-
-  subroutine d_set_default_nwm_w(ag)
-    use psb_realloc_mod
-    use iso_c_binding
-    implicit none 
-    class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
-    integer(psb_ipk_) :: info
-    
-    call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
-    ag%w_c_nxt%size      = psb_size(ag%w_nxt)
-    ag%w_c_nxt%owns_data = 0
-    if (ag%w_c_nxt%size > 0) call set_cloc(ag%w_nxt, ag%w_c_nxt)
-
-  end subroutine d_set_default_nwm_w
-
-  subroutine set_cloc(vect,w_c_nxt)
-    use iso_c_binding
-    real(psb_dpk_), target :: vect(:)
-    type(nwm_Vector) :: w_c_nxt
-    
-    w_c_nxt%data = c_loc(vect)
-  end subroutine set_cloc
-
-
-  subroutine d_newmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
-    use psb_realloc_mod
-    implicit none 
-    class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
-    integer(psb_lpk_), intent(in)  :: ilaggr(:)
-    real(psb_dpk_), intent(in)     :: valaggr(:)
-    integer(psb_ipk_), intent(in)  :: nx
-
-    integer(psb_ipk_) :: info,i,j
-
-    ! The vector was already fixed in the call to Newmatch.
-    call psb_realloc(nx,ag%w_nxt,info)
-    
-  end subroutine d_newmatch_bld_wnxt
-  
-  function d_newmatch_aggregator_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "new matching aggregation"
-  end function d_newmatch_aggregator_fmt
-
-  subroutine  d_newmatch_aggregator_descr(ag,parms,iout,info,prefix)
-    implicit none 
-    class(amg_d_newmatch_aggregator_type), intent(in) :: ag
-    type(amg_dml_parms), intent(in)   :: parms
-    integer(psb_ipk_), intent(in)  :: iout
-    integer(psb_ipk_), intent(out) :: info
-    character(len=*), intent(in), optional  :: prefix
-    character(1024)    :: prefix_
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    write(iout,*) trim(prefix_),' ','NewMatch Aggregator'
-    write(iout,*) trim(prefix_),' ','   Number of Matching   sweeps: ',ag%n_sweeps
-    write(iout,*) trim(prefix_),' ','   Matching algorithm         : ',ag%matching_alg
-    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info)
-    
-    return
-  end subroutine d_newmatch_aggregator_descr
-
-  function is_legal_malg(alg) result(val)
-    logical :: val
-    integer(psb_ipk_) :: alg
-
-    val = ((0<=alg).and.(alg<=2))
-  end function is_legal_malg
-
-  function is_legal_csize(csize) result(val)
-    logical :: val
-    integer(psb_ipk_) :: csize
-
-    val = ((-1==csize).or.(csize >0))
-  end function is_legal_csize
-
-  function is_legal_nsweeps(nsw) result(val)
-    logical :: val
-    integer(psb_ipk_) :: nsw
-
-    val = (1<=nsw)
-  end function is_legal_nsweeps
-
-  function is_legal_nlevels(nlv) result(val)
-    logical :: val
-    integer(psb_ipk_) :: nlv
-
-    val = (1<=nlv)
-  end function is_legal_nlevels
-  
-  subroutine  d_newmatch_aggregator_update_next(ag,agnext,info)
-    use psb_realloc_mod
-    implicit none 
-    class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
-    class(amg_d_base_aggregator_type), target, intent(inout) :: agnext
-    integer(psb_ipk_), intent(out)       :: info
-
-    !
-    !
-    select type(agnext)
-    class is (amg_d_newmatch_aggregator_type)
-      if (.not.is_legal_malg(agnext%matching_alg)) &
-           & agnext%matching_alg = ag%matching_alg
-      if (.not.is_legal_nsweeps(agnext%n_sweeps))&
-           & agnext%n_sweeps     = ag%n_sweeps 
-      if (.not.is_legal_csize(agnext%max_csize))&
-           & agnext%max_csize    = ag%max_csize 
-      if (.not.is_legal_nlevels(agnext%max_nlevels))&
-           & agnext%max_nlevels  = ag%max_nlevels
-      ! Is this going to generate shallow copies/memory leaks/double frees?
-      ! To be investigated further.
-      call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
-      call agnext%set_c_default_w()
-    class default
-      ! What should we do here? 
-    end select
-    info = 0 
-  end subroutine d_newmatch_aggregator_update_next
-
-  
-  subroutine amg_d_newmatch_aggr_csetr(ag,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_newmatch_aggregator_type), intent(inout) :: ag
-    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, iwhat
-    character(len=20)  :: name='d_newmatch_aggr_csetr'
-    info = psb_success_
-
-    ! For now we ignore IDX
-
-    select case(psb_toupper(trim(what)))
-    case('NWM_LAMBDA')
-      ag%lambda = val
-    case default
-      ! Do nothing
-    end select
-    return
-  end subroutine amg_d_newmatch_aggr_csetr
-  
-  subroutine amg_d_newmatch_aggr_csetc(ag,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_newmatch_aggregator_type), intent(inout) :: ag
-    character(len=*), intent(in)                  :: what
-    character(len=*), intent(in)                 :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act, iwhat
-    character(len=20)  :: name='d_newmatch_aggr_csetc'
-    info = psb_success_
-
-    ! For now we ignore IDX
-
-    select case(psb_toupper(trim(what)))
-    case('NWM_PARALLEL_MATCHING')
-      select case(psb_toupper(trim(val)))
-      case('SEQUENTIAL','F','FALSE')
-        ag%parallel_matching = .false.
-      case('PARALLEL','TRUE','T')
-        ag%parallel_matching =.true.
-      end select
-    case('NWM_REPRODUCIBLE_MATCHING')
-      select case(psb_toupper(trim(val)))
-      case('F','FALSE')
-        ag%reproducible_matching = .false.
-      case('REPRODUCIBLE','TRUE','T')
-        ag%reproducible_matching =.true.
-      end select
-    case('NWM_NEED_SYMMETRIZE')
-      select case(psb_toupper(trim(val)))
-      case('FALSE','F')
-        ag%need_symmetrize = .false.
-      case('SYMMETRIZE','TRUE','T')
-        ag%need_symmetrize =.true.
-      end select
-    case('NWM_UNSMOOTHED_HIERARCHY')
-      select case(psb_toupper(trim(val)))
-      case('F','FALSE')
-        ag%unsmoothed_hierarchy = .false.
-      case('T','TRUE')
-        ag%unsmoothed_hierarchy =.true.
-      end select
-    case default
-      ! Do nothing
-    end select
-    return
-  end subroutine amg_d_newmatch_aggr_csetc
-  
-  subroutine d_newmatch_aggr_cseti(ag,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_newmatch_aggregator_type), intent(inout) :: ag
-    character(len=*), intent(in)                  :: what
-    integer(psb_ipk_), intent(in)                 :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act, iwhat
-    character(len=20)  :: name='d_newmatch_aggr_cseti'
-    info = psb_success_
-
-    ! For now we ignore IDX
-    
-    select case(psb_toupper(trim(what)))
-    case('NWM_MATCH_ALG','NWM_MATCHING_ALG')
-      ag%matching_alg = val
-    case('NWM_SWEEPS')
-      ag%n_sweeps=val
-    case('NWM_MAX_CSIZE')
-      ag%max_csize = val
-    case('NWM_MAX_NLEVELS')
-      ag%max_nlevels = val
-    case('NWM_W_SIZE')
-      call ag%bld_default_w(val)
-    case('AGGR_SIZE')
-      ag%orig_aggr_size = val
-      ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
-    case default
-      ! Do nothing
-    end select
-    return
-  end subroutine d_newmatch_aggr_cseti
-
-  subroutine d_newmatch_aggr_set_default(ag)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_newmatch_aggregator_type), intent(inout) :: ag
-    character(len=20)  :: name='d_newmatch_aggr_set_default'
-    ag%matching_alg = 1
-    ag%n_sweeps     = 1
-    ag%max_nlevels  = 36
-    ag%max_csize    = -1
-    ag%lambda       = -1
-    !
-    ! Apparently newMatch works better
-    ! by keeping all entries
-    ! 
-    ag%do_clean_zeros = .false.
-
-    return
-
-  end subroutine d_newmatch_aggr_set_default
-
-  subroutine  d_newmatch_aggregator_free(ag,info)
-    use iso_c_binding
-    implicit none 
-    class(amg_d_newmatch_aggregator_type), intent(inout) :: ag
-    integer(psb_ipk_), intent(out)       :: info
-
-    info = 0
-    if (allocated(ag%w)) deallocate(ag%w,stat=info)
-    if (info /= 0) return
-    if (allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info)
-    if (info /= 0) return
-    ag%w_c_nxt%size = 0
-    ag%w_c_nxt%data = c_null_ptr
-    ag%w_c_nxt%owns_data = 0
-  end subroutine d_newmatch_aggregator_free
-
-  subroutine  d_newmatch_aggregator_clone(ag,agnext,info)
-    implicit none 
-    class(amg_d_newmatch_aggregator_type), intent(inout) :: ag
-    class(amg_d_base_aggregator_type), allocatable, intent(inout) :: agnext
-    integer(psb_ipk_), intent(out)       :: info
-
-    info = 0 
-    if (allocated(agnext)) then
-      call agnext%free(info)
-      if (info == 0) deallocate(agnext,stat=info)
-    end if
-    if (info /= 0) return
-    allocate(agnext,source=ag,stat=info)
-    select type(agnext)
-    class is (amg_d_newmatch_aggregator_type)
-      call agnext%set_c_default_w()
-    class default
-      ! Should never ever get here
-      info = -1
-    end select
-  end subroutine d_newmatch_aggregator_clone  
-  
-end module amg_d_newmatch_aggregator_mod
@@ -57,7 +57,6 @@ module amg_d_onelev_mod
  use amg_d_base_smoother_mod
  use amg_d_dec_aggregator_mod
  use amg_d_parmatch_aggregator_mod
-  use amg_d_newmatch_aggregator_mod

  use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, &
       & psb_d_base_vect_type, psb_ldspmat_type,  psb_dlinmap_type, psb_dpk_, &
@@ -189,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
@@ -274,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_, &
@@ -287,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, &
@@ -299,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, &
@@ -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
@@ -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
@@ -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
@@ -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


  !
@@ -58,6 +58,7 @@ 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
@@ -85,6 +86,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)
@@ -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)
@@ -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(:)
@@ -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, &
@@ -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, &
@@ -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
@@ -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
@@ -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
@@ -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, &
@@ -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
@@ -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
@@ -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


  !
@@ -58,6 +58,7 @@ 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
@@ -85,6 +86,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)
@@ -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)
@@ -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(:)
@@ -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, &
@@ -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, &
@@ -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
@@ -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
@@ -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
@@ -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, &
@@ -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


  !
@@ -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
@@ -5,7 +5,7 @@ MODDIR=../../../modules
 HERE=../..

 FINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR) $(PSBLAS_INCLUDES)
-CXXINCLUDES=$(FIFLAG)$(HERE) $(FIFLAG)$(INCDIR) $(FIFLAG)/. -I../../../../ParallelRomaF-main/include -I$(PSBLAS_INCDIR)
+CXXINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(INCDIR) $(FMFLAG)/.

 #CINCLUDES= -I${SUPERLU_INCDIR} -I${HSL_INCDIR}  -I${SPRAL_INCDIR} -I/home/users/pasqua/Ambra/BootCMatch/include -lBCM -L/home/users/pasqua/Ambra/BootCMatch/lib  -lm

@@ -59,18 +59,9 @@ amg_s_parmatch_spmm_bld.o \
 amg_s_parmatch_spmm_bld_ov.o \
 amg_s_parmatch_unsmth_bld.o \
 amg_s_parmatch_smth_bld.o \
-amg_s_parmatch_spmm_bld_inner.o \
-amg_d_newmatch_aggregator_inner_mat_asb.o\
-amg_d_newmatch_aggregator_mat_asb.o \
-amg_d_newmatch_aggregator_mat_bld.o \
-amg_d_newmatch_aggregator_tprol.o  \
-amg_d_newmatch_map_to_tprol.o \
-amg_d_newmatch_spmm_bld_inner.o \
-amg_d_newmatch_spmm_bld_ov.o
+amg_s_parmatch_spmm_bld_inner.o

-MPCXXOBJS=MatchBoxPC.o \
-algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o \
-newmatch_interface.o \
+MPCOBJS=MatchBoxPC.o \
 sendBundledMessages.o \
 initialize.o \
 extractUChunk.o \
@@ -85,10 +76,10 @@ processCrossEdge.o \
 queueTransfer.o \
 processMessages.o \
 processExposedVertex.o \
-algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.o \
-MatchingAlgorithms.o
+algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o \
+algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.o

-OBJS = $(FOBJS) $(MPCOBJS) $(MPCXXOBJS) 
+OBJS = $(FOBJS) $(MPCOBJS)

 LIBNAME=libamg_prec.a

@@ -98,6 +89,10 @@ lib:  objs
 	$(AR) $(HERE)/$(LIBNAME) $(OBJS)
 	$(RANLIB) $(HERE)/$(LIBNAME)

+mpobjs:
+	(make $(MPFOBJS) F90="$(MPF90)" F90COPT="$(F90COPT)")
+	(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
+
 veryclean: clean
 	/bin/rm -f $(LIBNAME)

@@ -67,13 +67,13 @@ void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
 #endif


-#define TIME_TRACKER
-    #ifdef TIME_TRACKER
-        double tmr = MPI_Wtime();
-    #endif
+#undef TIME_TRACKER
+#ifdef TIME_TRACKER
+  double tmr = MPI_Wtime();
+#endif

-#define OMP
-#ifdef OMP
+#if defined(OPENMP)
+	//fprintf(stderr,"Warning: using buggy OpenMP matching!\n");
        dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(NLVer, NLEdge,
 							   verLocPtr, verLocInd, edgeLocWeight,
 							   verDistance,  Mate,
@@ -92,11 +92,11 @@ void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
 #endif


-  #ifdef TIME_TRACKER
-    tmr = MPI_Wtime() - tmr;
-    fprintf(stderr, "Elaboration time: %f for %ld nodes\n", tmr, NLVer);
-  #endif
-
+#ifdef TIME_TRACKER
+	tmr = MPI_Wtime() - tmr;
+	fprintf(stderr, "Elaboration time: %f for %ld nodes\n", tmr, NLVer);
+#endif
+	
 #endif
 }

@@ -114,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
 }

@@ -59,7 +59,11 @@
 #include <assert.h>
 #include <map>
 #include <vector>
+#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"

@@ -78,6 +82,8 @@ const int BundleTag = 9;  // Predefined tag

 static vector<MilanLongInt> DEFAULT_VECTOR;

+#if !defined(SERIAL_MPI)
+
 // MPI type map
 template <typename T>
 MPI_Datatype TypeMap();
@@ -89,6 +95,7 @@ template <>
 inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
 template <>
 inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
+#endif

 #ifdef __cplusplus
 extern "C"
@@ -174,252 +181,416 @@ extern "C"
 #define MilanRealMin MINUS_INFINITY
 #endif

-    // Function of find the owner of a ghost vertex using binary search:
-    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. */

-    MilanLongInt firstComputeCandidateMate(MilanLongInt adj1,
-                                           MilanLongInt adj2,
-                                           MilanLongInt *verLocInd,
-                                           MilanReal *edgeLocWeight);
+  // 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 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);
+  
+  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);

-    bool isAlreadyMatched(MilanLongInt node,
-                          MilanLongInt StartIndex,
-                          MilanLongInt EndIndex,
-                          vector<MilanLongInt> &GMate,
-                          MilanLongInt *Mate,
-                          map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
+  MilanLongInt firstComputeCandidateMateS(MilanLongInt adj1,
+					 MilanLongInt adj2,
+					 MilanLongInt *verLocInd,
+					  MilanFloat *edgeLocWeight);

-    MilanLongInt computeCandidateMate(MilanLongInt adj1,
-                                      MilanLongInt adj2,
-                                      MilanReal *edgeLocWeight,
-                                      MilanLongInt k,
-                                      MilanLongInt *verLocInd,
-                                      MilanLongInt StartIndex,
-                                      MilanLongInt EndIndex,
-                                      vector<MilanLongInt> &GMate,
-                                      MilanLongInt *Mate,
-                                      map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
+  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 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 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 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_B(MilanLongInt NLVer,
-                                           MilanLongInt *verLocPtr,
-                                           MilanLongInt *verLocInd,
-                                           MilanInt myRank,
-                                           MilanReal *edgeLocWeight,
-                                           MilanLongInt *candidateMate);
-
-    void PARALLEL_PROCESS_EXPOSED_VERTEX_B(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 processMatchedVertices(
-        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 processMatchedVerticesAndSendMessages(
-        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 processMessages(
-        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 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 dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
        MilanLongInt NLVer, MilanLongInt NLEdge,
@@ -1303,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);
@@ -1,5 +1,4 @@
 #include "MatchBoxPC.h"
-
 // ***********************************************************************
 //
 //        MatchboxP: A C++ library for approximate weighted matching
@@ -126,8 +125,10 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
    fflush(stdout);
 #endif

-    MilanLongInt StartIndex = verDistance[myRank];       // The starting vertex owned by the current rank
-    MilanLongInt EndIndex   = verDistance[myRank + 1] - 1; // The ending vertex owned by the current rank
+    // The starting vertex owned by the current rank
+    MilanLongInt StartIndex = verDistance[myRank];
+    // The ending vertex owned by the current rank
+    MilanLongInt EndIndex   = verDistance[myRank + 1] - 1;

    MPI_Status computeStatus;

@@ -145,7 +146,8 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
    // only one message will be sent in the initialization phase -
    // one of: REQUEST/FAILURE/SUCCESS
    vector<MilanLongInt> QLocalVtx, QGhostVtx, QMsgType;
-    vector<MilanInt> QOwner; // Changed by Fabio to be an integer, addresses needs to be integers!
+    // Changed by Fabio to be an integer, addresses needs to be integers!
+    vector<MilanInt> QOwner; 

    MilanLongInt *PCounter = new MilanLongInt[numProcs];
    for (int i = 0; i < numProcs; i++)
@@ -153,7 +155,8 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(

    MilanLongInt NumMessagesBundled = 0;
    // TODO when the last computational section will be refactored this could be eliminated
-    MilanInt ghostOwner = 0; // Changed by Fabio to be an integer, addresses needs to be integers!
+    // Changed by Fabio to be an integer, addresses needs to be integers!
+    MilanInt ghostOwner = 0; 
    MilanLongInt *candidateMate = nullptr;
 #ifdef PRINT_DEBUG_INFO_
    cout << "\n(" << myRank << ")NV: " << NLVer << "  Edges: " << NLEdge;
@@ -168,9 +171,12 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
    MilanLongInt myCard = 0;

    // Build the Ghost Vertex Set: Vg
-    map<MilanLongInt, MilanLongInt> Ghost2LocalMap;       // Map each ghost vertex to a local vertex
-    vector<MilanLongInt> Counter;                         // Store the edge count for each ghost vertex
-    MilanLongInt numGhostVertices = 0, numGhostEdges = 0; // Number of Ghost vertices
+    // Map each ghost vertex to a local vertex
+    map<MilanLongInt, MilanLongInt> Ghost2LocalMap;
+    // Store the edge count for each ghost vertex
+    vector<MilanLongInt> Counter;
+    // Number of Ghost vertices
+    MilanLongInt numGhostVertices = 0, numGhostEdges = 0; 

 #ifdef PRINT_DEBUG_INFO_
    cout << "\n(" << myRank << ")About to compute Ghost Vertices...";
@@ -222,7 +228,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
    cout << myRank << " Finished initialization" << endl;
    fflush(stdout);
 #endif
-   
+
    startTime = MPI_Wtime();

    /////////////////////////////////////////////////////////////////////////////////////////
@@ -237,7 +243,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
     * PARALLEL_COMPUTE_CANDIDATE_MATE_B is now totally parallel.
     */

-    PARALLEL_COMPUTE_CANDIDATE_MATE_B(NLVer,
+    PARALLEL_COMPUTE_CANDIDATE_MATE_BD(NLVer,
                                      verLocPtr,
                                      verLocInd,
                                      myRank,
@@ -262,7 +268,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
     * TODO: Test when it's actually more efficient to execute this code
     *       in parallel.
     */
-    PARALLEL_PROCESS_EXPOSED_VERTEX_B(NLVer,
+    PARALLEL_PROCESS_EXPOSED_VERTEX_BD(NLVer,
                                      candidateMate,
                                      verLocInd,
                                      verLocPtr,
@@ -314,7 +320,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
    vector<MilanLongInt> UChunkBeingProcessed;
    UChunkBeingProcessed.reserve(UCHUNK);

-    processMatchedVertices(NLVer,
+    processMatchedVerticesD(NLVer,
                           UChunkBeingProcessed,
                           U,
                           privateU,
@@ -391,7 +397,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
    cout << myRank << " Finished sendBundles" << endl;
    fflush(stdout);
 #endif
- 
+
    *ph1_card = myCard;                 // Cardinality at the end of Phase-1
    startTime = MPI_Wtime();
    /////////////////////////////////////////////////////////////////////////////////////////
@@ -422,8 +428,8 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
        ///////////////////////////////////////////////////////////////////////////////////
        /////////////////////////// PROCESS MATCHED VERTICES //////////////////////////////
        ///////////////////////////////////////////////////////////////////////////////////
-      
-      processMatchedVerticesAndSendMessages(NLVer,
+
+      processMatchedVerticesAndSendMessagesD(NLVer,
 					    UChunkBeingProcessed,
 					    U,
 					    privateU,
@@ -456,7 +462,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
 					    comm,
 					    &msgActual,
 					    Message);
-      
+
      ///////////////////////// END OF PROCESS MATCHED VERTICES /////////////////////////

        //// BREAK IF NO MESSAGES EXPECTED /////////
@@ -483,8 +489,8 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
        ///////////////////////////////////////////////////////////////////////////////////
        /////////////////////////// PROCESS MESSAGES //////////////////////////////////////
        ///////////////////////////////////////////////////////////////////////////////////
-
-        processMessages(NLVer,
+	//startTime = MPI_Wtime();
+        processMessagesD(NLVer,
                        Mate,
                        candidateMate,
                        Ghost2LocalMap,
@@ -549,6 +555,489 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
    *ph2_card = myCard;                 // Cardinality at the end of Phase-2
 }
 // End of algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMate
+
+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)
+{
+
+    /*
+     * verDistance: it's a vector long as the number of processors.
+     *              verDistance[i] contains the first node index of the i-th processor
+     *              verDistance[i + 1] contains the last node index of the i-th processor
+     * NLVer: number of elements in the LocPtr
+     * NLEdge: number of edges assigned to the current processor
+     *
+     * Contains the portion of matrix assigned to the processor in
+     * Yale notation
+     * verLocInd: contains the positions on row of the matrix
+     * verLocPtr: i-th value is the position of the first element on the i-th row and
+     *            i+1-th value is the position of the first element on the i+1-th row
+     */
+
+#if !defined(SERIAL_MPI)
+#ifdef PRINT_DEBUG_INFO_
+    cout << "\n(" << myRank << ")Within algoEdgeApproxDominatingEdgesLinearSearchMessageBundling()";
+    fflush(stdout);
+#endif
+
+#ifdef PRINT_DEBUG_INFO_
+    cout << "\n(" << myRank << ") verDistance [" ;
+    for (int i = 0; i < numProcs; i++)
+      cout << verDistance[i] << "," << verDistance[i+1];
+    cout  << "]\n";
+    fflush(stdout);
+#endif
+#ifdef DEBUG_HANG_
+    if (myRank == 0) {
+      cout << "\n(" << myRank << ") verDistance [" ;
+      for (int i = 0; i < numProcs; i++)
+	cout << verDistance[i] << "," ;
+      cout  << verDistance[numProcs]<< "]\n";
+    }
+    fflush(stdout);
+#endif
+
+    // The starting vertex owned by the current rank
+    MilanLongInt StartIndex = verDistance[myRank];
+    // The ending vertex owned by the current rank
+    MilanLongInt EndIndex   = verDistance[myRank + 1] - 1;
+
+    MPI_Status computeStatus;
+
+    MilanLongInt msgActual = 0, msgInd = 0;
+    MilanFloat heaviestEdgeWt = 0.0f; // Assumes positive weight
+    MilanReal startTime, finishTime;
+
+    startTime = MPI_Wtime();
+
+    // Data structures for sending and receiving messages:
+    vector<MilanLongInt> Message; // [ u, v, message_type ]
+    Message.resize(3, -1);
+    // Data structures for Message Bundling:
+    // Although up to two messages can be sent along any cross edge,
+    // only one message will be sent in the initialization phase -
+    // one of: REQUEST/FAILURE/SUCCESS
+    vector<MilanLongInt> QLocalVtx, QGhostVtx, QMsgType;
+    // Changed by Fabio to be an integer, addresses needs to be integers!
+    vector<MilanInt> QOwner; 
+
+    MilanLongInt *PCounter = new MilanLongInt[numProcs];
+    for (int i = 0; i < numProcs; i++)
+        PCounter[i] = 0;
+
+    MilanLongInt NumMessagesBundled = 0;
+    // TODO when the last computational section will be refactored this could be eliminated
+    // Changed by Fabio to be an integer, addresses needs to be integers!
+    MilanInt ghostOwner = 0; 
+    MilanLongInt *candidateMate = nullptr;
+#ifdef PRINT_DEBUG_INFO_
+    cout << "\n(" << myRank << ")NV: " << NLVer << "  Edges: " << NLEdge;
+    fflush(stdout);
+    cout << "\n(" << myRank << ")StartIndex: " << StartIndex << "  EndIndex: " << EndIndex;
+    fflush(stdout);
+#endif
+    // Other Variables:
+    MilanLongInt u = -1, v = -1, w = -1, i = 0;
+    MilanLongInt k = -1, adj1 = -1, adj2 = -1;
+    MilanLongInt k1 = -1, adj11 = -1, adj12 = -1;
+    MilanLongInt myCard = 0;
+
+    // Build the Ghost Vertex Set: Vg
+    // Map each ghost vertex to a local vertex
+    map<MilanLongInt, MilanLongInt> Ghost2LocalMap;
+    // Store the edge count for each ghost vertex
+    vector<MilanLongInt> Counter;
+    // Number of Ghost vertices
+    MilanLongInt numGhostVertices = 0, numGhostEdges = 0; 
+
+#ifdef PRINT_DEBUG_INFO_
+    cout << "\n(" << myRank << ")About to compute Ghost Vertices...";
+    fflush(stdout);
+#endif
+#ifdef DEBUG_HANG_
+    if (myRank == 0)
+        cout << "\n(" << myRank << ")About to compute Ghost Vertices...";
+    fflush(stdout);
+#endif
+
+    // Define Adjacency Lists for Ghost Vertices:
+    // cout<<"Building Ghost data structures ... \n\n";
+    vector<MilanLongInt> verGhostPtr, verGhostInd, tempCounter;
+    // Mate array for ghost vertices:
+    vector<MilanLongInt> GMate; // Proportional to the number of ghost vertices
+    MilanLongInt S;
+    MilanLongInt privateMyCard = 0;
+    vector<MilanLongInt> PCumulative, PMessageBundle, PSizeInfoMessages;
+    vector<MPI_Request> SRequest;  // Requests that are used for each send message
+    vector<MPI_Status> SStatus;    // Status of sent messages, used in MPI_Wait
+    MilanLongInt MessageIndex = 0; // Pointer for current message
+    MilanInt BufferSize;
+    MilanLongInt *Buffer;
+
+    vector<MilanLongInt> privateQLocalVtx, privateQGhostVtx, privateQMsgType;
+    vector<MilanInt> privateQOwner;
+    vector<MilanLongInt> U, privateU;
+
+    
+    initialize(NLVer, NLEdge, StartIndex,
+               EndIndex, &numGhostEdges,
+               &numGhostVertices, &S,
+               verLocInd, verLocPtr,
+               Ghost2LocalMap, Counter,
+               verGhostPtr, verGhostInd,
+               tempCounter, GMate,
+               Message, QLocalVtx,
+               QGhostVtx, QMsgType, QOwner,
+               candidateMate, U,
+               privateU,
+               privateQLocalVtx,
+               privateQGhostVtx,
+               privateQMsgType,
+               privateQOwner);
+
+    finishTime = MPI_Wtime();
+    *ph0_time = finishTime - startTime; // Time taken for Phase-0: Initialization
+#ifdef DEBUG_HANG_
+    cout << myRank << " Finished initialization" << endl;
+    fflush(stdout);
+#endif
+
+    startTime = MPI_Wtime();
+
+    /////////////////////////////////////////////////////////////////////////////////////////
+    //////////////////////////////////// INITIALIZATION /////////////////////////////////////
+    /////////////////////////////////////////////////////////////////////////////////////////
+    // Compute the Initial Matching Set:
+
+    /*
+     * OMP PARALLEL_COMPUTE_CANDIDATE_MATE_B has been splitted from
+     * PARALLEL_PROCESS_EXPOSED_VERTEX_B in order to better parallelize
+     * the two.
+     * PARALLEL_COMPUTE_CANDIDATE_MATE_B is now totally parallel.
+     */
+
+    PARALLEL_COMPUTE_CANDIDATE_MATE_BS(NLVer,
+                                      verLocPtr,
+                                      verLocInd,
+                                      myRank,
+                                      edgeLocWeight,
+                                      candidateMate);
+
+#ifdef DEBUG_HANG_
+    cout << myRank << " Finished Exposed Vertex" << endl;
+    fflush(stdout);
+#if 0
+    cout << myRank << " candidateMate after parallelCompute " <<endl;
+    for (int i=0; i<NLVer; i++) {
+      cout << candidateMate[i] << " " ;
+    }
+    cout << endl;
+#endif
+#endif
+    /*
+     * PARALLEL_PROCESS_EXPOSED_VERTEX_B
+     * TODO: write comment
+     *
+     * TODO: Test when it's actually more efficient to execute this code
+     *       in parallel.
+     */
+    PARALLEL_PROCESS_EXPOSED_VERTEX_BS(NLVer,
+                                      candidateMate,
+                                      verLocInd,
+                                      verLocPtr,
+                                      StartIndex,
+                                      EndIndex,
+                                      Mate,
+                                      GMate,
+                                      Ghost2LocalMap,
+                                      edgeLocWeight,
+                                      &myCard,
+                                      &msgInd,
+                                      &NumMessagesBundled,
+                                      &S,
+                                      verDistance,
+                                      PCounter,
+                                      Counter,
+                                      myRank,
+                                      numProcs,
+                                      U,
+                                      privateU,
+                                      QLocalVtx,
+                                      QGhostVtx,
+                                      QMsgType,
+                                      QOwner,
+                                      privateQLocalVtx,
+                                      privateQGhostVtx,
+                                      privateQMsgType,
+                                      privateQOwner);
+
+    tempCounter.clear(); // Do not need this any more
+
+#ifdef DEBUG_HANG_
+    cout << myRank << " Finished Exposed Vertex" << endl;
+    fflush(stdout);
+#if 0
+    cout << myRank << " Mate after Exposed Vertices " <<endl;
+    for (int i=0; i<NLVer; i++) {
+      cout << Mate[i] << " " ;
+    }
+    cout << endl;
+#endif
+#endif
+
+    ///////////////////////////////////////////////////////////////////////////////////
+    /////////////////////////// PROCESS MATCHED VERTICES //////////////////////////////
+    ///////////////////////////////////////////////////////////////////////////////////
+
+    // TODO what would be the optimal UCHUNK
+    vector<MilanLongInt> UChunkBeingProcessed;
+    UChunkBeingProcessed.reserve(UCHUNK);
+
+    processMatchedVerticesS(NLVer,
+                           UChunkBeingProcessed,
+                           U,
+                           privateU,
+                           StartIndex,
+                           EndIndex,
+                           &myCard,
+                           &msgInd,
+                           &NumMessagesBundled,
+                           &S,
+                           verLocPtr,
+                           verLocInd,
+                           verDistance,
+                           PCounter,
+                           Counter,
+                           myRank,
+                           numProcs,
+                           candidateMate,
+                           GMate,
+                           Mate,
+                           Ghost2LocalMap,
+                           edgeLocWeight,
+                           QLocalVtx,
+                           QGhostVtx,
+                           QMsgType,
+                           QOwner,
+                           privateQLocalVtx,
+                           privateQGhostVtx,
+                           privateQMsgType,
+                           privateQOwner);
+
+
+#ifdef DEBUG_HANG_
+    cout << myRank << " Finished Process Vertices" << endl;
+    fflush(stdout);
+#if 0
+    cout << myRank << " Mate after Matched Vertices " <<endl;
+    for (int i=0; i<NLVer; i++) {
+      cout << Mate[i] << " " ;
+    }
+    cout << endl;
+#endif
+#endif
+
+    /////////////////////////////////////////////////////////////////////////////////////////
+    ///////////////////////////// SEND BUNDLED MESSAGES /////////////////////////////////////
+    /////////////////////////////////////////////////////////////////////////////////////////
+
+    sendBundledMessages(&numGhostEdges,
+                        &BufferSize,
+                        Buffer,
+                        PCumulative,
+                        PMessageBundle,
+                        PSizeInfoMessages,
+                        PCounter,
+                        NumMessagesBundled,
+                        &msgActual,
+                        &MessageIndex,
+                        numProcs,
+                        myRank,
+                        comm,
+                        QLocalVtx,
+                        QGhostVtx,
+                        QMsgType,
+                        QOwner,
+                        SRequest,
+                        SStatus);
+
+    ///////////////////////// END OF SEND BUNDLED MESSAGES //////////////////////////////////
+
+    finishTime = MPI_Wtime();
+    *ph1_time = finishTime - startTime; // Time taken for Phase-1
+
+#ifdef DEBUG_HANG_
+    cout << myRank << " Finished sendBundles" << endl;
+    fflush(stdout);
+#endif
+
+    *ph1_card = myCard;                 // Cardinality at the end of Phase-1
+    startTime = MPI_Wtime();
+    /////////////////////////////////////////////////////////////////////////////////////////
+    //////////////////////////////////////// MAIN LOOP //////////////////////////////////////
+    /////////////////////////////////////////////////////////////////////////////////////////
+    // Main While Loop:
+#ifdef PRINT_DEBUG_INFO_
+    cout << "\n(" << myRank << "=========================************===============================" << endl;
+    fflush(stdout);
+    fflush(stdout);
+#endif
+#ifdef PRINT_DEBUG_INFO_
+    cout << "\n(" << myRank << ")Entering While(true) loop..";
+    fflush(stdout);
+#endif
+#ifdef PRINT_DEBUG_INFO_
+    cout << "\n(" << myRank << "=========================************===============================" << endl;
+    fflush(stdout);
+    fflush(stdout);
+#endif
+
+    while (true)  {
+#ifdef DEBUG_HANG_
+      //if (myRank == 0)
+      cout << "\n(" << myRank << ") Main loop" << endl;
+      fflush(stdout);
+#endif
+        ///////////////////////////////////////////////////////////////////////////////////
+        /////////////////////////// PROCESS MATCHED VERTICES //////////////////////////////
+        ///////////////////////////////////////////////////////////////////////////////////
+
+      processMatchedVerticesAndSendMessagesS(NLVer,
+					    UChunkBeingProcessed,
+					    U,
+					    privateU,
+					    StartIndex,
+					    EndIndex,
+					    &myCard,
+					    &msgInd,
+					    &NumMessagesBundled,
+					    &S,
+					    verLocPtr,
+					    verLocInd,
+					    verDistance,
+					    PCounter,
+					    Counter,
+					    myRank,
+					    numProcs,
+					    candidateMate,
+					    GMate,
+					    Mate,
+					    Ghost2LocalMap,
+					    edgeLocWeight,
+					    QLocalVtx,
+					    QGhostVtx,
+					    QMsgType,
+					    QOwner,
+					    privateQLocalVtx,
+					    privateQGhostVtx,
+					    privateQMsgType,
+					    privateQOwner,
+					    comm,
+					    &msgActual,
+					    Message);
+
+      ///////////////////////// END OF PROCESS MATCHED VERTICES /////////////////////////
+
+        //// BREAK IF NO MESSAGES EXPECTED /////////
+#ifdef DEBUG_HANG_
+#if 0
+      cout << myRank << " Mate after ProcessMatchedAndSend phase "<<S <<endl;
+      for (int i=0; i<NLVer; i++) {
+	cout << Mate[i] << " " ;
+      }
+      cout << endl;
+#endif
+#endif
+#ifdef PRINT_DEBUG_INFO_
+        cout << "\n(" << myRank << ")Deciding whether to break: S= " << S << endl;
+#endif
+
+        if (S == 0) {
+#ifdef DEBUG_HANG_
+	  cout << "\n(" << myRank << ") Breaking out" << endl;
+	  fflush(stdout);
+#endif
+	  break;
+        }
+        ///////////////////////////////////////////////////////////////////////////////////
+        /////////////////////////// PROCESS MESSAGES //////////////////////////////////////
+        ///////////////////////////////////////////////////////////////////////////////////
+
+        processMessagesS(NLVer,
+                        Mate,
+                        candidateMate,
+                        Ghost2LocalMap,
+                        GMate,
+                        Counter,
+                        StartIndex,
+                        EndIndex,
+                        &myCard,
+                        &msgInd,
+                        &msgActual,
+                        edgeLocWeight,
+                        verDistance,
+                        verLocPtr,
+                        k,
+                        verLocInd,
+                        numProcs,
+                        myRank,
+                        comm,
+                        Message,
+                        numGhostEdges,
+                        u,
+                        v,
+                        &S,
+                        U);
+
+        ///////////////////////// END OF PROCESS MESSAGES /////////////////////////////////
+#ifdef DEBUG_HANG_
+#if 0
+      cout << myRank << " Mate after ProcessMessages phase "<<S <<endl;
+      for (int i=0; i<NLVer; i++) {
+	cout << Mate[i] << " " ;
+      }
+      cout << endl;
+#endif
+#endif
+#ifdef PRINT_DEBUG_INFO_
+        cout << "\n(" << myRank << ")Finished Message processing phase: S= " << S;
+        fflush(stdout);
+        cout << "\n(" << myRank << ")** SENT     : ACTUAL= " << msgActual;
+        fflush(stdout);
+        cout << "\n(" << myRank << ")** SENT     : INDIVIDUAL= " << msgInd << endl;
+        fflush(stdout);
+#endif
+    } // End of while (true)
+
+    clean(NLVer,
+          myRank,
+          MessageIndex,
+          SRequest,
+          SStatus,
+          BufferSize,
+          Buffer,
+          msgActual,
+          msgActualSent,
+          msgInd,
+          msgIndSent,
+          NumMessagesBundled,
+          msgPercent);
+
+    finishTime = MPI_Wtime();
+    *ph2_time = finishTime - startTime; // Time taken for Phase-2
+    *ph2_card = myCard;                 // Cardinality at the end of Phase-2
+}
+
 #endif

 #endif
+#endif
@@ -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_
@@ -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()

@@ -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()

@@ -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
-
@@ -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')
@@ -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
@@ -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()
@@ -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
@@ -141,6 +145,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  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

@@ -173,6 +178,9 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  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()
@@ -185,7 +193,7 @@ 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
@@ -200,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')
@@ -230,9 +256,15 @@ 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 
@@ -240,7 +272,6 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
    call acsrf%clean_zeros(info)
  end if

-
  !$OMP parallel do private(i) schedule(static)
  do i=1,size(adiag)
    if (adiag(i) /= czero) then
@@ -252,14 +283,17 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  !$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_')
@@ -322,6 +356,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  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

@@ -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_
@@ -1,166 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-! File: amg_d_newmatch_aggregator_mat_asb.f90
-!
-! Subroutine: amg_d_newmatch_aggregator_mat_asb
-! Version:    real
-!
-!
-!  From a given AC to final format, generating DESC_AC.
-!  This is quite involved, because in the context of aggregation based
-!  on parallel matching we are building the matrix hierarchy within BLD_TPROL
-!  as we go, especially if we have multiple sweeps, hence this code is called
-!  in two completely different contexts:
-!  1. Within bld_tprol for the internal hierarchy
-!  2. Outside, from amg_hierarchy_bld
-!  The solution we have found is for bld_tprol to copy its output
-!  into special components ag%ac ag%desc_ac etc so that:
-!  1. if they are  allocated, it means that bld_tprol has been already invoked, we are in
-!     amg_hierarchy_bld and we only need to copy them
-!  2. If they are not allocated, we are within bld_tprol, and we need to actually
-!     perform the various needed steps.
-!
-! Arguments:
-!    ag       -  type(amg_d_newmatch_aggregator_type), input/output.
-!               The aggregator object
-!    parms   -  type(amg_dml_parms), input
-!               The aggregation parameters
-!    a          -  type(psb_dspmat_type), input.
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!    ilaggr     -  integer, dimension(:), input
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that the indices
-!                  are assumed to be shifted so as to make sure the ranges on
-!                  the various processes do not   overlap.
-!    nlaggr     -  integer, dimension(:) input
-!                  nlaggr(i) contains the aggregates held by process i.
-!    ac         -  type(psb_dspmat_type), inout
-!                  The coarse matrix
-!    desc_ac    -  type(psb_desc_type), output.
-!                  The communication descriptor of the fine-level matrix.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!
-!    op_prol    -  type(psb_dspmat_type), input/output
-!                  The tentative prolongator on input, the computed prolongator on output
-!
-!    op_restr    -  type(psb_dspmat_type), input/output
-!                  The restrictor operator; normally, it is the transpose of the prolongator.
-!
-!    info       -  integer, output.
-!                  Error code.
-!
-subroutine  amg_d_newmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
-     & ac,desc_ac, op_prol,op_restr,info)
-  use psb_base_mod
-  use amg_base_prec_type
-#if defined(SERIAL_MPI)
-  use amg_d_newmatch_aggregator_mod
-#else
-  use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_inner_mat_asb
-#endif
-  implicit none
-  class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
-  type(amg_dml_parms), intent(inout)    :: parms
-  type(psb_dspmat_type), intent(in)     :: a
-  type(psb_desc_type), intent(in)       :: desc_a
-  type(psb_dspmat_type), intent(inout) :: op_prol,op_restr
-  type(psb_dspmat_type), intent(inout)  :: ac
-  type(psb_desc_type), intent(inout)    :: desc_ac
-  integer(psb_ipk_), intent(out)        :: info
-  !
-  type(psb_ctxt_type)         :: ictxt
-  integer(psb_ipk_)           :: np, me
-  type(psb_ld_coo_sparse_mat) :: acoo, bcoo
-  type(psb_ld_csr_sparse_mat) :: acsr1
-  integer(psb_ipk_)           :: nzl, inl
-  integer(psb_lpk_)           :: ntaggr
-  integer(psb_ipk_) :: err_act, debug_level, debug_unit
-  character(len=20) :: name='d_newmatch_inner_mat_asb'
-  character(len=80) :: aname
-  logical, parameter :: debug=.false., dump_prol_restr=.false.
-
-
-  if (psb_get_errstatus().ne.0) return
-  call psb_erractionsave(err_act)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-  info  = psb_success_
-  ictxt = desc_a%get_context()
-  call psb_info(ictxt,me,np)
-
-#if !defined(SERIAL_MPI)
-
-  if (debug) write(0,*) me,' ',trim(name),' Start:',&
-       & allocated(ag%ac),allocated(ag%desc_ac), allocated(ag%prol),allocated(ag%restr)
-
-  select case(parms%coarse_mat)
-
-  case(amg_distr_mat_)
-    ! Do nothing, it has already been done in spmm_bld_ov.
-
-  case(amg_repl_mat_)
-    !
-    !
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='no repl coarse_mat_ here')
-    goto 9999
-
-  case default
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
-    goto 9999
-  end select
-#endif
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-  return
-
-
-end subroutine amg_d_newmatch_aggregator_inner_mat_asb
@@ -1,150 +0,0 @@
-!   
-!  
-! File: amg_d_newmatch_aggregator_mat_asb.f90
-!
-! Subroutine: amg_d_newmatch_aggregator_mat_asb
-! Version:    real
-!
-!
-!  From a given AC to final format, generating DESC_AC
-! 
-! Arguments:
-!    ag       -  type(amg_d_newmatch_aggregator_type), input/output.
-!               The aggregator object
-!    parms   -  type(amg_dml_parms), input 
-!               The aggregation parameters
-!    a          -  type(psb_dspmat_type), input.     
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!    ilaggr     -  integer, dimension(:), input
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that the indices
-!                  are assumed to be shifted so as to make sure the ranges on
-!                  the various processes do not   overlap.
-!    nlaggr     -  integer, dimension(:) input
-!                  nlaggr(i) contains the aggregates held by process i.
-!    ac         -  type(psb_dspmat_type), inout
-!                  The coarse matrix 
-!    desc_ac    -  type(psb_desc_type), output.
-!                  The communication descriptor of the fine-level matrix.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!                  
-!    op_prol    -  type(psb_dspmat_type), input/output
-!                  The tentative prolongator on input, the computed prolongator on output
-!               
-!    op_restr    -  type(psb_dspmat_type), input/output
-!                  The restrictor operator; normally, it is the transpose of the prolongator. 
-!               
-!    info       -  integer, output.
-!                  Error code.
-!  
-subroutine  amg_d_newmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
-     & ac,desc_ac, op_prol,op_restr,info)
-  use psb_base_mod
-  use amg_base_prec_type
-  use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_mat_asb
-  implicit none
-  class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
-  type(amg_dml_parms), intent(inout)    :: parms 
-  type(psb_dspmat_type), intent(in)     :: a
-  type(psb_desc_type), intent(inout)    :: desc_a
-  type(psb_dspmat_type), intent(inout) :: op_prol, ac,op_restr
-  type(psb_desc_type), intent(inout)    :: desc_ac
-  integer(psb_ipk_), intent(out)        :: info
-  !
-  type(psb_ctxt_type)         :: ctxt
-  integer(psb_ipk_)           :: np, me
-  type(psb_ld_coo_sparse_mat) :: tmpcoo
-  type(psb_ldspmat_type)      :: tmp_ac
-  integer(psb_ipk_)           :: i_nr, i_nc, i_nl, nzl
-  integer(psb_lpk_)           :: ntaggr
-  integer(psb_ipk_) :: err_act, debug_level, debug_unit
-  character(len=20) :: name='d_newmatch_aggregator_mat_asb'
-
-
-  if (psb_get_errstatus().ne.0) return 
-  call psb_erractionsave(err_act)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-  info  = psb_success_
-  ctxt = desc_a%get_context()
-  call psb_info(ctxt,me,np)
-
-  select case(parms%coarse_mat)
-
-  case(amg_distr_mat_) 
-
-    call ac%cscnv(info,type='csr')
-    call op_prol%cscnv(info,type='csr')
-    call op_restr%cscnv(info,type='csr')
-
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done ac '
-
-  case(amg_repl_mat_) 
-    !
-    ! We are assuming here that an d matrix
-    ! can hold all entries
-    !
-    if (desc_ac%get_global_rows() < huge(1_psb_ipk_) ) then 
-      ntaggr = desc_ac%get_global_rows()
-      i_nr   = ntaggr
-    else
-      info = psb_err_internal_error_
-      call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
-      goto 9999
-    end if
-    
-    call op_prol%mv_to(tmpcoo)
-    nzl = tmpcoo%get_nzeros()
-    call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
-    call op_prol%mv_from(tmpcoo)
-
-    call op_restr%mv_to(tmpcoo)
-    nzl = tmpcoo%get_nzeros()
-    call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
-    call op_restr%mv_from(tmpcoo)
-
-    call op_prol%set_ncols(i_nr)
-    call op_restr%set_nrows(i_nr)
-
-    call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
-         & dupl=psb_dupl_add_,keeploc=.false.)
-    call tmp_ac%mv_to(tmpcoo)
-    call ac%mv_from(tmpcoo)
-    
-    call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
-    if (info == psb_success_) call psb_cdasb(desc_ac,info)
-    !
-    ! Now that we have the descriptors and the restrictor, we should
-    ! update the W. But we don't, because REPL is only valid
-    ! at the coarsest level, so no need to carry over.
-    !
-
-    if (info /= psb_success_) goto 9999
-
-  case default 
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
-    goto 9999
-  end select
-
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-  return
-
-
-end subroutine amg_d_newmatch_aggregator_mat_asb
@@ -1,183 +0,0 @@
-!   
-!  
-! File: amg_d_base_aggregator_mat_bld.f90
-!
-! Subroutine: amg_d_base_aggregator_mat_bld
-! Version:    real
-!
-!  This routine builds the matrix associated to the current level of the
-!  multilevel preconditioner from the matrix associated to the previous level,
-!  by using the user-specified aggregation technique (therefore, it also builds the
-!  prolongation and restriction operators mapping the current level to the
-!  previous one and vice versa). 
-!  The current level is regarded as the coarse one, while the previous as
-!  the fine one. This is in agreement with the fact that the routine is called,
-!  by amg_mlprec_bld, only on levels >=2.
-!  The coarse-level matrix A_C is built from a fine-level matrix A
-!  by using the Galerkin approach, i.e.
-!
-!                               A_C = P_C^T A P_C,
-!
-!  where P_C is a prolongator from the coarse level to the fine one.
-! 
-!  A mapping from the nodes of the adjacency graph of A to the nodes of the
-!  adjacency graph of A_C has been computed by the amg_aggrmap_bld subroutine.
-!  The prolongator P_C is built here from this mapping, according to the
-!  value of p%iprcparm(amg_aggr_kind_), specified by the user through
-!  amg_dprecinit and amg_zprecset.
-!  On output from this routine the entries of AC, op_prol, op_restr
-!  are still in "global numbering" mode; this is fixed in the calling routine
-!  amg_d_lev_aggrmat_bld.
-!
-!  Currently four  different prolongators are implemented, corresponding to
-!  four  aggregation algorithms:
-!  1. un-smoothed aggregation,
-!  2. smoothed aggregation,
-!  3. "bizarre" aggregation.
-!  4. minimum energy 
-!  1. The non-smoothed aggregation uses as prolongator the piecewise constant
-!     interpolation operator corresponding to the fine-to-coarse level mapping built
-!     by p%aggr%bld_tprol. This is called tentative prolongator.
-!  2. The smoothed aggregation uses as prolongator the operator obtained by applying
-!     a damped Jacobi smoother to the tentative prolongator.
-!  3. The "bizarre" aggregation uses a prolongator proposed by the authors of MLD2P4.
-!     This prolongator still requires a deep analysis and testing and its use is
-!     not recommended.
-!  4. Minimum energy aggregation
-!
-!  For more details see
-!    M. Brezina and P. Vanek, A black-box iterative solver based on a two-level
-!    Schwarz method, Computing,  63 (1999), 233-263.
-!    P. D'Ambra, D. di Serafino and S. Filippone, On the development of PSBLAS-based
-!    parallel two-level Schwarz preconditioners, Appl. Num. Math., 57 (2007),
-!    1181-1196.
-!    M. Sala, R. Tuminaro: A new Petrov-Galerkin smoothed aggregation preconditioner
-!    for nonsymmetric linear systems, SIAM J. Sci. Comput., 31(1):143-166 (2008)
-!
-!
-!  The main structure is:
-!  1. Perform sanity checks;
-!  2. Compute prolongator/restrictor/AC
-!
-! 
-! Arguments:
-!    ag       -  type(amg_d_base_aggregator_type), input/output.
-!               The aggregator object
-!    parms   -  type(amg_dml_parms), input 
-!               The aggregation parameters
-!    a          -  type(psb_dspmat_type), input.     
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!    ilaggr     -  integer, dimension(:), input
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that the indices
-!                  are assumed to be shifted so as to make sure the ranges on
-!                  the various processes do not   overlap.
-!    nlaggr     -  integer, dimension(:) input
-!                  nlaggr(i) contains the aggregates held by process i.
-!    ac         -  type(psb_dspmat_type), output
-!                  The coarse matrix on output 
-!                  
-!    op_prol    -  type(psb_dspmat_type), input/output
-!                  The tentative prolongator on input, the computed prolongator on output
-!               
-!    op_restr    -  type(psb_dspmat_type), output
-!                  The restrictor operator; normally, it is the transpose of the prolongator. 
-!               
-!    info       -  integer, output.
-!                  Error code.
-!  
-subroutine  amg_d_newmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
-  use psb_base_mod
-  use amg_d_inner_mod
-  use amg_d_prec_type, amg_protect_name => amg_d_newmatch_aggregator_mat_bld
-  !use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_mat_bld
-  implicit none
-  
-  class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
-  type(amg_dml_parms), intent(inout)    :: parms 
-  type(psb_dspmat_type), intent(in)     :: a
-  type(psb_desc_type), intent(inout)    :: desc_a
-  integer(psb_lpk_), intent(inout)      :: ilaggr(:), nlaggr(:)
-  type(psb_ldspmat_type), intent(inout) :: t_prol
-  type(psb_dspmat_type), intent(inout)  :: op_prol,ac,op_restr
-  type(psb_desc_type), intent(inout)    :: desc_ac
-  integer(psb_ipk_), intent(out)        :: info
-
-  ! Local variables
-  character(len=20)           :: name
-  type(psb_ctxt_type)         :: ctxt
-  integer(psb_mpk_)           :: np, me
-  type(psb_ld_coo_sparse_mat) :: acoo, bcoo
-  type(psb_ld_csr_sparse_mat) :: acsr1
-  integer(psb_lpk_)           :: nzl,ntaggr
-  integer(psb_ipk_)           :: err_act
-  integer(psb_ipk_)           :: debug_level, debug_unit
-
-  name='amg_d_newmatch_aggregator_mat_bld'
-  if (psb_get_errstatus().ne.0) return 
-  call psb_erractionsave(err_act)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-  info  = psb_success_
-  ctxt = desc_a%get_context()
-  call psb_info(ctxt,me,np)
-
-  !
-  ! Build the coarse-level matrix from the fine-level one, starting from 
-  ! the mapping defined by amg_aggrmap_bld and applying the aggregation
-  ! algorithm specified by 
-  !
-  select case (parms%aggr_prol)
-  case (amg_no_smooth_) 
-
-!!$    call amg_d_newmatch_unsmth_spmm_bld(a,desc_a,ilaggr,nlaggr,&
-!!$         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
-    call amg_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr, &
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
-
-
-  case(amg_smooth_prol_) 
-
-    call amg_daggrmat_smth_bld(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)
-
-  case default
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='Invalid aggr kind')
-    goto 9999
-
-  end select
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner aggrmat bld')
-    goto 9999
-  end if
-
-
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-  return
-
-  
-end subroutine amg_d_newmatch_aggregator_mat_bld
@@ -1,448 +0,0 @@
-!   
-!  
-! File: amg_d_newmatch_aggregator_tprol.f90
-!
-! Subroutine: amg_d_newmatch_aggregator_tprol
-! Version:    real
-!
-!
-
-subroutine  amg_d_newmatch_aggregator_build_tprol(ag,parms,ag_data,&
-     & a,desc_a,ilaggr,nlaggr,t_prol,info)
-  use psb_base_mod
-  use amg_base_prec_type
-  use amg_d_inner_mod
-  use amg_d_decmatch_mod
-#if defined(SERIAL_MPI)
-    use amg_d_newmatch_aggregator_mod
-#else
-  use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_build_tprol
-#endif
-  use iso_c_binding
-  implicit none
-  class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
-  type(amg_dml_parms), intent(inout)   :: parms
-  type(amg_daggr_data), intent(in)     :: ag_data
-  type(psb_dspmat_type), intent(inout) :: a
-  type(psb_desc_type), intent(inout)      :: desc_a
-  integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
-  type(psb_ldspmat_type), intent(out)  :: t_prol
-  integer(psb_ipk_), intent(out)      :: info
-
-
-  ! Local variables
-  real(psb_dpk_), allocatable    :: tmpw(:), tmpwnxt(:)
-  integer(psb_lpk_), allocatable :: ixaggr(:), nxaggr(:), tlaggr(:), ivr(:)
-  type(psb_dspmat_type)          :: a_tmp
-  type(nwm_CSRMatrix) :: C, P
-  integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels
-  character(len=40)    :: name, ch_err
-  character(len=80)    :: fname, prefix_
-  type(psb_ctxt_type)  :: ictxt
-  integer(psb_ipk_)    :: np, me
-  integer(psb_ipk_)    :: err_act, ierr
-  integer(psb_ipk_)    :: debug_level, debug_unit
-  integer(psb_ipk_)    :: i, j, k, nr, nc
-  integer(psb_lpk_)    :: isz, num_pcols, nrac, ncac, lname, nz, x_sweeps, csz
-  integer(psb_lpk_)    :: psz, sizes(4)
-  type(psb_d_csr_sparse_mat), target  :: csr_prol, csr_pvi, csr_prod_res, acsr
-  type(psb_ld_csr_sparse_mat), target :: lcsr_prol
-  type(psb_desc_type), allocatable    :: desc_acv(:)
-  type(psb_ld_coo_sparse_mat)         :: tmpcoo, transp_coo
-  type(psb_dspmat_type), allocatable  :: acv(:)
-  type(psb_dspmat_type), allocatable  :: prolv(:), restrv(:)
-  type(psb_ldspmat_type)              :: tmp_prol, tmp_pg, tmp_restr
-  type(psb_desc_type)                 :: tmp_desc_ac, tmp_desc_ax, tmp_desc_p
-  integer(psb_ipk_), save             :: idx_mboxp=-1, idx_spmmbld=-1, idx_sweeps_mult=-1
-  logical, parameter :: dump=.false., do_timings=.true., debug=.false., &
-       & dump_prol_restr=.false.
-  name='d_newmatch_tprol'
-  ictxt = desc_a%get_context()
-  call psb_info(ictxt,me,np)
-  if (psb_get_errstatus().ne.0) then
-    write(0,*) me,trim(name),' Err_status :',psb_get_errstatus()
-    return
-  end if
-  if (debug) write(0,*) me,trim(name),' Start '
-  call psb_erractionsave(err_act)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-  info  = psb_success_
-
-  if ((do_timings).and.(idx_mboxp==-1))       &
-       & idx_mboxp = psb_get_timer_idx("PMC_TPROL: MatchBoxP")
-  if ((do_timings).and.(idx_spmmbld==-1))     &
-       & idx_spmmbld = psb_get_timer_idx("PMC_TPROL: spmm_bld")
-  if ((do_timings).and.(idx_sweeps_mult==-1)) &
-       & idx_sweeps_mult = psb_get_timer_idx("PMC_TPROL: sweeps_mult")
-
-
-  call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
-       &   amg_mult_ml_,is_legal_ml_cycle)
-  call amg_check_def(parms%par_aggr_alg,'Aggregation',&
-       &   amg_coupled_aggr_,is_legal_decoupled_par_aggr_alg)
-  call amg_check_def(parms%aggr_ord,'Ordering',&
-       &   amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
-  call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
-
-#if !defined(SERIAL_MPI)
-
-  match_algorithm = ag%matching_alg
-  n_sweeps        = ag%n_sweeps
-  if (2**n_sweeps /= ag%orig_aggr_size) then
-    if (me == 0) then
-      write(debug_unit, *) 'Warning: AGGR_SIZE reset to value ',2**n_sweeps
-    end if
-  end if
-  if (ag%max_csize > 0) then
-    max_csize       = ag%max_csize
-  else
-    max_csize       = ag_data%min_coarse_size
-  end if
-  if (ag%max_nlevels > 0) then
-    max_nlevels     = ag%max_nlevels
-  else
-    max_nlevels = ag_data%max_levs
-  end if
-  if (.true.) then
-    block
-      integer(psb_ipk_) :: ipv(2)
-      ipv(1) = max_csize
-      ipv(2) = n_sweeps
-      call psb_bcast(ictxt,ipv)
-      max_csize = ipv(1)
-      n_sweeps  = ipv(2)
-    end block
-  else
-    call psb_bcast(ictxt,max_csize)
-    call psb_bcast(ictxt,n_sweeps)
-  end if
-  if (n_sweeps /= ag%n_sweeps) then
-    write(0,*) me,' Inconsistent N_SWEEPS ',n_sweeps,ag%n_sweeps
-  end if
-  n_sweeps = max(1,n_sweeps)
-
-  if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,max_csize
-  if (ag%unsmoothed_hierarchy.and.allocated(ag%base_a)) then
-    call ag%base_a%cp_to(acsr)
-    if (ag%do_clean_zeros) call acsr%clean_zeros(info)
-    nr = acsr%get_nrows()
-    if (psb_size(ag%w) < nr) call ag%bld_default_w(nr)
-    isz = acsr%get_ncols()
-
-    call psb_realloc(isz,ixaggr,info)
-    if (info == psb_success_) &
-         & allocate(acv(0:n_sweeps), desc_acv(0:n_sweeps),&
-         &  prolv(n_sweeps), restrv(n_sweeps),stat=info)
-
-    if (info /= psb_success_) then
-      info=psb_err_from_subroutine_
-      ch_err='psb_realloc'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-
-    end if
-
-
-    call acv(0)%mv_from(acsr)
-    call ag%base_desc%clone(desc_acv(0),info)
-
-  else
-    call a%cp_to(acsr)
-    if (ag%do_clean_zeros) call acsr%clean_zeros(info)
-    nr = acsr%get_nrows()
-    if (psb_size(ag%w) < nr) call ag%bld_default_w(nr)
-    isz = acsr%get_ncols()
-  
-    call psb_realloc(isz,ixaggr,info)
-    if (info == psb_success_) &
-         & allocate(acv(0:n_sweeps), desc_acv(0:n_sweeps),&
-         &  prolv(n_sweeps), restrv(n_sweeps),stat=info)
-
-    if (info /= psb_success_) then
-      info=psb_err_from_subroutine_
-      ch_err='psb_realloc'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-
-    end if
-
-
-    call acv(0)%mv_from(acsr)
-    call desc_a%clone(desc_acv(0),info)
-  end if
-  
-  nrac = desc_acv(0)%get_local_rows()
-  ncac = desc_acv(0)%get_local_cols()
-  if (debug) write(0,*) me,' On input to level: ',nrac, ncac
-  if (allocated(ag%prol)) then
-    call ag%prol%free()
-    deallocate(ag%prol)
-  end if
-  if (allocated(ag%restr)) then
-    call ag%restr%free()
-    deallocate(ag%restr)
-  end if
-
-  if (dump) then
-    block
-      type(psb_ldspmat_type) :: lac
-      ivr = desc_acv(0)%get_global_indices(owned=.false.)
-      prefix_ = "input_a"
-      lname = len_trim(prefix_)
-      fname = trim(prefix_)
-      write(fname(lname+1:lname+9),'(a,i3.3,a)') '_p',me, '.mtx'
-      call acv(0)%print(fname,head='Debug aggregates')
-      call lac%cp_from(acv(0))
-      write(fname(lname+1:lname+13),'(a,i3.3,a)') '_p',me, '-glb.mtx'
-      call lac%print(fname,head='Debug aggregates',iv=ivr)
-      call lac%free()
-    end block
-  end if
-
-  call psb_geall(tmpw,desc_acv(0),info)
-
-  tmpw(1:nr) = ag%w(1:nr)
-
-  call psb_geasb(tmpw,desc_acv(0),info)
-
-  if (debug) then
-    call psb_barrier(ictxt)
-    if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),max_csize
-  end if
-
-  !
-  ! Prepare ag%ac, ag%desc_ac, ag%prol, ag%restr to enable
-  !         shortcuts in mat_bld and mat_asb
-  ! and ag%desc_ax which will be needed in backfix.
-  !
-  x_sweeps = -1
-  sweeps_loop: do i=1, n_sweeps
-    if (debug) then
-      call psb_barrier(ictxt)
-      if (me==0) write(0,*) me,trim(name),' Start sweeps_loop iteration:',i,' of ',n_sweeps
-    end if
-
-    !
-    ! Building prol and restr because this algorithm is not decoupled
-    ! On exit from matchbox_build_prol,  prolv(i) is in global numbering
-    !
-    !
-    if (debug) write(0,*) me,' Into matchbox_build_prol ',info
-    if (do_timings) call psb_tic(idx_mboxp)
-    call amg_ddecmatch_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,&
-         & symmetrize=ag%need_symmetrize,reproducible=ag%reproducible_matching,&
-         & parallel=ag%parallel_matching,matching=ag%matching_alg,lambda=ag%lambda)
-    if (do_timings) call psb_toc(idx_mboxp)
-    if (debug) write(0,*) me,' Out from matchbox_build_prol ',info
-    if (psb_errstatus_fatal())  write(0,*)me,trim(name),'Error fatal on exit bld_tprol',info
-
-
-    if (debug) then
-      call psb_barrier(ictxt)
-!!$      write(0,*) name,' Call spmm_bld sweep:',i,n_sweeps
-      if (me==0) write(0,*) me,trim(name),' Calling spmm_bld  NSW>1:',i,&
-           & desc_acv(i-1)%get_local_rows(),desc_acv(i-1)%get_local_cols(),&
-           & desc_acv(i-1)%get_global_rows()
-    end if
-    if (i == n_sweeps) call tmp_prol%clone(tmp_pg,info)
-    if (do_timings) call psb_tic(idx_spmmbld)
-    !
-    !  On entry, prolv(i) is in global numbering,
-    !
-    call amg_d_newmatch_spmm_bld_ov(acv(i-1),desc_acv(i-1),ixaggr,nxaggr,parms,&
-         & acv(i),desc_acv(i), prolv(i),restrv(1),tmp_prol,info)
-    if (psb_errstatus_fatal())  write(0,*)me,trim(name),'Error fatal on exit from bld_ov(i)',info
-    if (debug) then
-      call psb_barrier(ictxt)
-      if (me==0) write(0,*) me,trim(name),' Done spmm_bld:',i
-    end if
-
-    if (do_timings) call psb_toc(idx_spmmbld)
-    ! Keep a copy of prolv(i) in global numbering for the time being, will
-    ! need it to build the final
-    ! if (i == n_sweeps) call prolv(i)%clone(tmp_prol,info)
-    call ag%inner_mat_asb(parms,acv(i-1),desc_acv(i-1),&
-         & acv(i),desc_acv(i),prolv(i),restrv(1),info)
-
-    if (debug) then
-      call psb_barrier(ictxt)
-      if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),max_csize,info
-      csz = sum(nxaggr)
-      call psb_bcast(ictxt,csz)
-      if (csz /= sum(nxaggr)) write(0,*) me,trim(name),' Mismatch matasb',&
-           & csz,sum(nxaggr),max_csize
-    end if
-    if (psb_errstatus_fatal())  write(0,*)me,trim(name),'Error fatal on entry to tmpwnxt 2'
-
-
-    !
-    ! Fix wnxt
-    !
-    if (info == 0) call psb_geall(tmpwnxt,desc_acv(i),info)
-    if (info == 0) call psb_geasb(tmpwnxt,desc_acv(i),info,scratch=.true.)
-    if (info == 0) call psb_halo(tmpw,desc_acv(i-1),info)
-!!$      write(0,*) trestr%get_nrows(),size(tmpwnxt),trestr%get_ncols(),size(tmpw)
-
-    if (info == 0) call psb_csmm(done,restrv(1),tmpw,dzero,tmpwnxt,info)
-
-    if (info /= psb_success_) then
-      write(0,*)me,trim(name),'Error from mat_asb/tmpw ',info
-      info=psb_err_from_subroutine_
-      call psb_errpush(info,name,a_err='mat_asb 2')
-      goto 9999
-    end if
-
-
-    if (i == 1) then
-      nrac = desc_acv(1)%get_local_rows()
-!!$      write(0,*) 'Copying output w_nxt ',nrac
-      call psb_realloc(nrac,ag%w_nxt,info)
-      ag%w_nxt(1:nrac) = tmpwnxt(1:nrac)
-      !
-      !  ILAGGR is fixed later on, but
-      !  get a copy in case of an early exit
-      !
-      call psb_safe_ab_cpy(ixaggr,ilaggr,info)
-    end if
-    call psb_safe_ab_cpy(nxaggr,nlaggr,info)
-    call move_alloc(tmpwnxt,tmpw)
-    if (debug) then
-      if (csz /= sum(nlaggr)) write(0,*) me,trim(name),' Mismatch 2 matasb',&
-           & csz,sum(nlaggr),max_csize, info
-    end if
-    call acv(i-1)%free()
-    if ((sum(nlaggr) <= max_csize).or.(any(nlaggr==0))) then
-      x_sweeps = i
-      exit sweeps_loop
-    end if
-    if (debug) then
-      call psb_barrier(ictxt)
-      if (me==0) write(0,*) me,trim(name),' Done sweeps_loop iteration:',i,' of ',n_sweeps
-    end if
-
-  end do sweeps_loop
-
-  if (debug) then
-    call psb_barrier(ictxt)
-    if (me==0) write(0,*) me,trim(name),' Done sweeps_loop:',x_sweeps
-  end if
-  if (x_sweeps<=0) x_sweeps = n_sweeps
-
-  if (do_timings) call psb_tic(idx_sweeps_mult)
-  !
-  ! Ok, now we have all the prolongators, including the last one in global numbering.
-  ! Build the product of all prolongators. Need a tmp_desc_ax
-  ! which is correct but most of the time overdimensioned
-  !
-  if (.not.allocated(ag%desc_ax)) allocate(ag%desc_ax)
-  !
-  block
-    integer(psb_ipk_) :: i, nnz
-    integer(psb_lpk_) :: ncol, ncsave
-    if (.not.allocated(ag%ac)) allocate(ag%ac)
-    if (.not.allocated(ag%desc_ac)) allocate(ag%desc_ac)
-    call desc_acv(x_sweeps)%clone(ag%desc_ac,info)
-    call desc_acv(x_sweeps)%free(info)
-    call acv(x_sweeps)%move_alloc(ag%ac,info)
-    if (.not.allocated(ag%prol)) allocate(ag%prol)
-    if (.not.allocated(ag%restr)) allocate(ag%restr)
-
-    call psb_cd_reinit(ag%desc_ac,info)
-    ncsave =  ag%desc_ac%get_global_rows()
-    !
-    ! Note: prolv(i) is already in local numbering
-    ! because of the call to mat_asb in the loop above.
-    !
-    call prolv(x_sweeps)%mv_to(csr_prol)
-    if (debug) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'Enter prolongator product loop ',x_sweeps
-    end if
-
-    do i=x_sweeps-1, 1, -1
-      call prolv(i)%mv_to(csr_pvi)
-      if (psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 1'
-      call psb_par_spspmm(csr_pvi,desc_acv(i),csr_prol,csr_prod_res,ag%desc_ac,info)
-      if ((info /=0).or.psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 2',info
-      call csr_pvi%free()
-      call csr_prod_res%mv_to_fmt(csr_prol,info)
-      if ((info /=0).or.psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 3',info
-      call csr_prol%set_ncols(ag%desc_ac%get_local_cols())
-      if ((info /=0).or.psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 4'
-    end do
-    call csr_prol%mv_to_lfmt(lcsr_prol,info)
-    nnz = lcsr_prol%get_nzeros()
-    call ag%desc_ac%l2gip(lcsr_prol%ja(1:nnz),info)
-    call lcsr_prol%set_ncols(ncsave)
-    if (debug) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'Done prolongator product loop ',x_sweeps
-    end if
-    !
-    ! Fix ILAGGR here by copying from CSR_PROL%JA
-    !
-    block
-      integer(psb_ipk_) :: nr
-      nr = lcsr_prol%get_nrows()
-      if (nnz /= nr) then
-        write(0,*) me,name,' Issue with prolongator? ',nr,nnz
-      end if
-      call psb_realloc(nr,ilaggr,info)
-      ilaggr(1:nnz) = lcsr_prol%ja(1:nnz)
-    end block
-    call tmp_prol%mv_from(lcsr_prol)
-    call psb_cdasb(ag%desc_ac,info)
-    call ag%ac%set_ncols(ag%desc_ac%get_local_cols())
-  end block
-
-  call tmp_prol%move_alloc(t_prol,info)
-  call t_prol%set_ncols(ag%desc_ac%get_local_cols())
-  call t_prol%set_nrows(desc_acv(0)%get_local_rows())
-
-  nrac = ag%desc_ac%get_local_rows()
-  ncac = ag%desc_ac%get_local_cols()
-  call psb_realloc(nrac,ag%w_nxt,info)
-  ag%w_nxt(1:nrac) = tmpw(1:nrac)
-
-
-  if (do_timings) call psb_toc(idx_sweeps_mult)
-
-  if (debug) then
-    call psb_barrier(ictxt)
-    if (me == 0) write(0,*) 'Out of build loop ',x_sweeps,': Output size:',sum(nlaggr)
-  end if
-
-
-  !call psb_set_debug_level(0)
-  if (dump) then
-    block
-      ivr = desc_acv(x_sweeps)%get_global_indices(owned=.false.)
-      prefix_ = "final_ac"
-      lname = len_trim(prefix_)
-      fname = trim(prefix_)
-      write(fname(lname+1:lname+9),'(a,i3.3,a)') '_p',me, '.mtx'
-      call acv(x_sweeps)%print(fname,head='Debug aggregates')
-      write(fname(lname+1:lname+13),'(a,i3.3,a)') '_p',me, '-glb.mtx'
-      call acv(x_sweeps)%print(fname,head='Debug aggregates',iv=ivr)
-      prefix_ = "final_tp"
-      lname = len_trim(prefix_)
-      fname = trim(prefix_)
-      write(fname(lname+1:lname+9),'(a,i3.3,a)') '_p',me, '.mtx'
-      call t_prol%print(fname,head='Tentative prolongator')
-    end block
-  end if
-
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_bootCMatch_if')
-    goto 9999
-  end if
-#endif
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-  return
-
-end subroutine amg_d_newmatch_aggregator_build_tprol
-  
@@ -1,128 +0,0 @@
-!   
-!  
-! File: amg_d_newmatch_map_to_tprol.f90
-!
-! Subroutine: amg_d_newmatch_map_to_tprol
-! Version:    real
-!
-!  This routine uses a mapping from the row indices of the fine-level matrix
-!  to the row indices of the coarse-level matrix to build a tentative
-!  prolongator, i.e. a piecewise constant operator.
-!  This is later used to build the final operator; the code has been refactored here
-!  to  be shared among all the methods that provide the tentative prolongator
-!  through a simple integer mapping.
-!
-!  The aggregation algorithm is a parallel version of that described in
-!  * M. Brezina and P. Vanek, A black-box iterative solver based on a 
-!    two-level Schwarz method, Computing,  63 (1999), 233-263.
-!  * P. Vanek, J. Mandel and M. Brezina, Algebraic Multigrid by Smoothed
-!    Aggregation for Second and Fourth Order Elliptic Problems, Computing, 56
-!    (1996), 179-196.
-!  For more details see
-!    P. D'Ambra, D. di Serafino and S. Filippone, On the development of
-!    PSBLAS-based parallel two-level Schwarz preconditioners, Appl. Num. Math.
-!    57 (2007), 1181-1196.
-!
-!
-! Arguments:
-!    aggr_type  -  integer, input.
-!                  The scalar used to identify the aggregation algorithm.
-!    theta      -  real, input.
-!                  The aggregation threshold used in the aggregation algorithm.
-!    a          -  type(psb_dspmat_type), input.     
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!    ilaggr     -  integer, dimension(:), allocatable.
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that on exit the indices
-!                  will be shifted so as to make sure the ranges on the various processes do not
-!                  overlap.
-!    nlaggr     -  integer, dimension(:), allocatable.
-!                  nlaggr(i) contains the aggregates held by process i.
-!    op_prol    -  type(psb_dspmat_type).
-!               The tentative prolongator, based on ilaggr.
-!               
-!    info       -  integer, output.
-!                  Error code.
-!
-subroutine amg_d_newmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr, op_prol,info)
-
-  use psb_base_mod
-  use amg_d_inner_mod!, amg_protect_name => amg_d_newmatch_map_to_tprol
-  use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_map_to_tprol
-
-  implicit none
-
-  ! Arguments
-  type(psb_desc_type), intent(in)    :: desc_a
-  integer(psb_lpk_), allocatable, intent(inout)  :: ilaggr(:),nlaggr(:)
-  real(psb_dpk_), allocatable, intent(inout)  :: valaggr(:)
-  type(psb_ldspmat_type), intent(out)  :: op_prol
-  integer(psb_ipk_), intent(out)               :: info
-
-  ! Local variables
-  integer(psb_lpk_)   :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr
-  type(psb_ld_coo_sparse_mat) :: tmpcoo
-  integer(psb_ipk_)   :: debug_level, debug_unit,err_act
-  type(psb_ctxt_type) :: ctxt
-  integer(psb_ipk_)   :: np, me
-  integer(psb_lpk_)   :: nrow, ncol, n_ne
-  character(len=20)   :: name, ch_err
-
-  if(psb_get_errstatus() /= 0) return 
-  info=psb_success_
-  name = 'amg_d_newmatch_map_to_tprol'
-  call psb_erractionsave(err_act)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-  !
-  ctxt=desc_a%get_context()
-  call psb_info(ctxt,me,np)
-  nrow  = desc_a%get_local_rows()
-  ncol  = desc_a%get_local_cols()
-
-  naggr   = nlaggr(me+1)
-  ntaggr  = sum(nlaggr)
-  naggrm1 = sum(nlaggr(1:me))
-  naggrp1 = sum(nlaggr(1:me+1))
-  ilaggr(1:nrow) = ilaggr(1:nrow) + naggrm1
-  call psb_halo(ilaggr,desc_a,info)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_halo')
-    goto 9999
-  end if
-
-  call psb_halo(valaggr,desc_a,info)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_halo')
-    goto 9999
-  end if
-
-  call tmpcoo%allocate(ncol,ntaggr,ncol)
-  j = 0
-  do i=1,ncol
-    if (valaggr(i) /= dzero) then
-      j = j + 1
-      tmpcoo%val(j) = valaggr(i)
-      tmpcoo%ia(j)  = i
-      tmpcoo%ja(j)  = ilaggr(i)
-    end if
-  end do
-  call tmpcoo%set_nzeros(j)
-  call tmpcoo%set_dupl(psb_dupl_add_)
-  call tmpcoo%set_sorted() ! At this point this is in row-major
-  call op_prol%mv_from(tmpcoo)
-
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-
-  return
-
-end subroutine amg_d_newmatch_map_to_tprol
@@ -1,218 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-! File: amg_daggrmat_nosmth_bld.F90
-!
-! Subroutine: amg_daggrmat_nosmth_bld
-! Version:    real
-!
-!  This routine builds a coarse-level matrix A_C from a fine-level matrix A
-!  by using the Galerkin approach, i.e.
-!
-!                               A_C = P_C^T A P_C,
-!
-!  where P_C is the piecewise constant interpolation operator corresponding
-!  the fine-to-coarse level mapping built by amg_aggrmap_bld.
-!
-!  The coarse-level matrix A_C is distributed among the parallel processes or
-!  replicated on each of them, according to the value of p%parms%coarse_mat
-!  specified by the user through amg_dprecinit and amg_zprecset.
-!  On output from this routine the entries of AC, op_prol, op_restr
-!  are still in "global numbering" mode; this is fixed in the calling routine
-!
-!  For details see
-!    P. D'Ambra, D. di Serafino and  S. Filippone, On the development of
-!    PSBLAS-based parallel two-level Schwarz preconditioners, Appl. Num. Math.,
-!    57 (2007), 1181-1196.
-!
-!
-! Arguments:
-!    a          -  type(psb_dspmat_type), input.
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!    p          -  type(amg_d_onelev_type), input/output.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!    parms      -   type(amg_dml_parms), input
-!                  Parameters controlling the choice of algorithm
-!    ac         -  type(psb_dspmat_type), output
-!                  The coarse matrix on output
-!
-!    ilaggr     -  integer, dimension(:), input
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that the indices
-!                  are assumed to be shifted so as to make sure the ranges on
-!                  the various processes do not   overlap.
-!    nlaggr     -  integer, dimension(:) input
-!                  nlaggr(i) contains the aggregates held by process i.
-!    op_prol    -  type(psb_dspmat_type), input/output
-!                  The tentative prolongator on input, the computed prolongator on output
-!
-!    op_restr    -  type(psb_dspmat_type), output
-!                  The restrictor operator; normally, it is the transpose of the prolongator.
-!
-!    info       -  integer, output.
-!                  Error code.
-!
-!
-subroutine amg_d_newmatch_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
-  use psb_base_mod
-  use amg_d_inner_mod
-#if defined(SERIAL_MPI)
-    use amg_d_newmatch_aggregator_mod
-#else
-  use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_spmm_bld_inner
-#endif
-  implicit none
-
-  ! Arguments
-  type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
-  type(psb_desc_type), intent(inout)          :: desc_a
-  integer(psb_lpk_), intent(inout)          :: ilaggr(:), nlaggr(:)
-  type(amg_dml_parms), intent(inout)        :: parms
-  type(psb_ldspmat_type), intent(inout)     :: t_prol
-  type(psb_dspmat_type), intent(inout)      :: ac, op_prol, op_restr
-  type(psb_desc_type), intent(out)          :: desc_ac
-  integer(psb_ipk_), intent(out)            :: info
-
-  ! Local variables
-  integer(psb_ipk_)   :: err_act
-  type(psb_ctxt_type) :: ictxt
-  integer(psb_ipk_)   :: np, me, ndx
-  character(len=40)   :: name
-  type(psb_ld_coo_sparse_mat) :: tmpcoo
-  type(psb_d_coo_sparse_mat)  :: coo_prol, coo_restr
-  type(psb_d_csr_sparse_mat)  :: ac_csr, csr_restr
-  type(psb_desc_type), target  :: tmp_desc
-  type(psb_ldspmat_type)     :: lac
-  integer(psb_ipk_) :: debug_level, debug_unit, naggr
-  integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nrl, nzl, ip, &
-       &  nzt, naggrm1, naggrp1, i, k
-  integer(psb_lpk_), allocatable :: ia(:),ja(:)
-  !integer(psb_lpk_) ::  nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave
-  logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
-  integer(psb_ipk_), save :: idx_spspmm=-1, idx_prolcnv=-1, idx_proltrans=-1, idx_asb=-1
-
-  name='amg_newmatch_spmm_bld_inner'
-  if(psb_get_errstatus().ne.0) return
-  info=psb_success_
-  call psb_erractionsave(err_act)
-
-
-  ictxt = desc_a%get_context()
-  call psb_info(ictxt, me, np)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-  nglob = desc_a%get_global_rows()
-  nrow  = desc_a%get_local_rows()
-  ncol  = desc_a%get_local_cols()
-
-  if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("SPMM_BLD: spspmm   ")
-  if ((do_timings).and.(idx_prolcnv==-1)) &
-       & idx_prolcnv = psb_get_timer_idx("SPMM_BLD: prolcnv  ")
-  if ((do_timings).and.(idx_proltrans==-1)) &
-       & idx_proltrans = psb_get_timer_idx("SPMM_BLD: proltrans")
-  if ((do_timings).and.(idx_asb==-1)) &
-       & idx_asb = psb_get_timer_idx("SPMM_BLD: asb      ")
-
-  if (do_timings) call psb_tic(idx_prolcnv)
-  naggr   = nlaggr(me+1)
-  ntaggr  = sum(nlaggr)
-  naggrm1 = sum(nlaggr(1:me))
-  naggrp1 = sum(nlaggr(1:me+1))
-
-#if !defined(SERIAL_MPI)
-  !
-  ! Here T_PROL should be arriving with GLOBAL indices on the cols
-  ! and LOCAL indices on the rows.
-  !
-  if (debug) write(0,*)  me,' ',trim(name),' Size check on entry New: ',&
-       & op_prol%get_fmt(),op_prol%get_nrows(),op_prol%get_ncols(),op_prol%get_nzeros(),&
-       & nrow,ntaggr,naggr
-
-  call t_prol%cp_to(tmpcoo)
-
-  call psb_cdall(ictxt,desc_ac,info,nl=naggr)
-  nzl = tmpcoo%get_nzeros()
-  if (debug) write(0,*)  me,' ',trim(name),' coo_prol: ',&
-       & tmpcoo%ia(1:min(10,nzl)),' :',tmpcoo%ja(1:min(10,nzl))
-  call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzl),info)
-  call tmpcoo%set_ncols(desc_ac%get_local_cols())
-  call tmpcoo%cp_to_icoo(coo_prol,info)
-
-  call amg_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
-       & coo_prol,desc_ac,coo_restr,info)
-
-  nzl = coo_prol%get_nzeros()
-  if (debug) write(0,*)  me,' ',trim(name),' coo_prol: ',&
-       & coo_prol%ia(1:min(10,nzl)),' :',coo_prol%ja(1:min(10,nzl))
-
-  call op_prol%mv_from(coo_prol)
-  call op_restr%mv_from(coo_restr)
-
-  if (debug) then
-    write(0,*) me,' ',trim(name),' Checkpoint at exit'
-    call psb_barrier(ictxt)
-    write(0,*) me,' ',trim(name),' Checkpoint through'
-  end if
-
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x a3')
-    goto 9999
-  end if
-
-
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done smooth_aggregate '
-#endif
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-
-  return
-
-end subroutine amg_d_newmatch_spmm_bld_inner
@@ -1,169 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-! File: amg_daggrmat_nosmth_bld_ov.F90
-!
-! Subroutine: amg_daggrmat_nosmth_bld_ov
-! Version:    real
-!
-!  This routine builds a coarse-level matrix A_C from a fine-level matrix A
-!  by using the Galerkin approach, i.e.
-!
-!                               A_C = P_C^T A P_C,
-!
-!  where P_C is the piecewise constant interpolation operator corresponding
-!  the fine-to-coarse level mapping built by amg_aggrmap_bld_ov.
-!
-!  The coarse-level matrix A_C is distributed among the parallel processes or
-!  replicated on each of them, according to the value of p%parms%coarse_mat
-!  specified by the user through amg_dprecinit and amg_zprecset.
-!  On output from this routine the entries of AC, op_prol, op_restr
-!  are still in "global numbering" mode; this is fixed in the calling routine
-!
-!  For details see
-!    P. D'Ambra, D. di Serafino and  S. Filippone, On the development of
-!    PSBLAS-based parallel two-level Schwarz preconditioners, Appl. Num. Math.,
-!    57 (2007), 1181-1196.
-!
-!
-! Arguments:
-!    a          -  type(psb_dspmat_type), input.
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!    p          -  type(amg_d_onelev_type), input/output.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!    parms      -   type(amg_dml_parms), input
-!                  Parameters controlling the choice of algorithm
-!    ac         -  type(psb_dspmat_type), output
-!                  The coarse matrix on output
-!
-!    ilaggr     -  integer, dimension(:), input
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that the indices
-!                  are assumed to be shifted so as to make sure the ranges on
-!                  the various processes do not   overlap.
-!    nlaggr     -  integer, dimension(:) input
-!                  nlaggr(i) contains the aggregates held by process i.
-!    op_prol    -  type(psb_dspmat_type), input/output
-!                  The tentative prolongator on input, the computed prolongator on output
-!
-!    op_restr    -  type(psb_dspmat_type), output
-!                  The restrictor operator; normally, it is the transpose of the prolongator.
-!
-!    info       -  integer, output.
-!                  Error code.
-!
-!
-subroutine amg_d_newmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
-  use psb_base_mod
-  use amg_d_inner_mod
-#if defined(SERIAL_MPI)
-    use amg_d_newmatch_aggregator_mod
-#else
-  use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_spmm_bld_ov
-#endif
-  implicit none
-
-  ! Arguments
-  type(psb_dspmat_type), intent(inout)    :: a
-  type(psb_desc_type), intent(inout)       :: desc_a
-  integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-  type(amg_dml_parms), intent(inout)      :: parms
-  type(psb_ldspmat_type), intent(inout)   :: t_prol
-  type(psb_dspmat_type), intent(inout)      :: ac, op_prol, op_restr
-  type(psb_desc_type), intent(out)        :: desc_ac
-  integer(psb_ipk_), intent(out)          :: info
-
-  ! Local variables
-  integer(psb_ipk_)  :: err_act
-
-  type(psb_ctxt_type) :: ictxt
-  integer(psb_ipk_)   :: np, me
-  character(len=20)   :: name
-  type(psb_d_csr_sparse_mat) :: acsr
-  type(psb_ld_coo_sparse_mat) :: coo_prol, coo_restr
-  integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
-       & naggr, nzt, naggrm1, naggrp1, i, k
-  integer(psb_ipk_) :: inaggr, nzlp
-  integer(psb_ipk_) :: debug_level, debug_unit
-  logical, parameter :: debug=.false., new_version=.true.
-
-  name='amg_newmatch_spmm_bld_ov'
-  if(psb_get_errstatus().ne.0) return
-  info=psb_success_
-  call psb_erractionsave(err_act)
-
-
-  ictxt = desc_a%get_context()
-  call psb_info(ictxt, me, np)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-
-#if !defined(SERIAL_MPI)
-
-  call a%mv_to(acsr)
-
-  call  amg_d_newmatch_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,&
-       & ac,desc_ac,op_prol,op_restr,t_prol,info)
-  if (psb_errstatus_fatal())  write(0,*)me,trim(name),'Error fatal on exit from bld_inner',info
-
-  if (info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    call psb_errpush(info,name,a_err="SPMM_BLD_INNER")
-    goto 9999
-  end if
-
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done spmm_bld '
-#endif
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-
-  return
-
-end subroutine amg_d_newmatch_spmm_bld_ov
@@ -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_
@@ -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_) &
@@ -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()
@@ -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()

@@ -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()

@@ -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
-
@@ -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')
@@ -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
@@ -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()
@@ -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
@@ -141,6 +145,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  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

@@ -173,6 +178,9 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  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()
@@ -185,7 +193,7 @@ 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
@@ -200,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')
@@ -230,9 +256,15 @@ 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 
@@ -240,7 +272,6 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
    call acsrf%clean_zeros(info)
  end if

-
  !$OMP parallel do private(i) schedule(static)
  do i=1,size(adiag)
    if (adiag(i) /= dzero) then
@@ -252,14 +283,17 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  !$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_')
@@ -322,6 +356,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  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

@@ -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_
@@ -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_
@@ -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_) &
@@ -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()
@@ -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()

@@ -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()

@@ -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
-
@@ -68,9 +68,12 @@
 !
 subroutine amg_s_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_s_inner_mod
+#if defined(OPENMP)
+  use omp_lib
+#endif

  implicit none

@@ -99,6 +102,9 @@ subroutine amg_s_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_s_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_s_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_s_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_s_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_s_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_s_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_s_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')
@@ -69,6 +69,7 @@
 !
 !
 ! Arguments:
+!    dol1smoothing - fictitious integer argument, it is not used inside
 !    a          -  type(psb_sspmat_type), input.     
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -104,8 +105,8 @@
 !                  Error code.
 !
 !
-subroutine amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_saggrmat_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_s_inner_mod, amg_protect_name => amg_saggrmat_minnrg_bld
@@ -113,6 +114,7 @@ subroutine amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
  implicit none

  ! Arguments
+  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(:)
@@ -171,6 +173,13 @@ subroutine amg_saggrmat_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_saggrmat_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
@@ -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_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_saggrmat_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_s_inner_mod, amg_protect_name => amg_saggrmat_nosmth_bld
@@ -105,6 +106,7 @@ subroutine amg_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  implicit none

  ! Arguments
+  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(:)
@@ -137,6 +139,12 @@ subroutine amg_saggrmat_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()
@@ -69,6 +69,8 @@
 !
 !
 ! Arguments:
+!    dol1smooth -  Integer taking the type of smoother that has to be used
+!                  on the tentative prolongator
 !    a          -  type(psb_sspmat_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_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_saggrmat_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_s_inner_mod, amg_protect_name => amg_saggrmat_smth_bld
  use amg_s_base_aggregator_mod
+!  use, intrinsic :: ieee_arithmetic

  implicit none

  ! Arguments
+  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(:)
@@ -132,7 +136,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  type(psb_s_coo_sparse_mat) :: coo_prol, coo_restr
  type(psb_s_csr_sparse_mat) :: acsr1,  acsrf, csr_prol, acsr
  real(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
@@ -141,6 +145,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  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

@@ -173,6 +178,9 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  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()
@@ -185,7 +193,7 @@ subroutine amg_saggrmat_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
@@ -200,6 +208,24 @@ subroutine amg_saggrmat_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')
@@ -230,9 +256,15 @@ subroutine amg_saggrmat_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 
@@ -240,7 +272,6 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
    call acsrf%clean_zeros(info)
  end if

-
  !$OMP parallel do private(i) schedule(static)
  do i=1,size(adiag)
    if (adiag(i) /= szero) then
@@ -252,14 +283,17 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  !$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_')
@@ -322,6 +356,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
  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

@@ -177,23 +177,24 @@ subroutine  amg_z_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
  select case (parms%aggr_prol)
  case (amg_no_smooth_) 

-    call amg_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,&
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_zaggrmat_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_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr, &
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_zaggrmat_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_zaggrmat_biz_bld(a,desc_a,ilaggr,nlaggr, &
 !!$         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
-
+  
  case(amg_min_energy_) 

-    call amg_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, &
-         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_zaggrmat_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_
@@ -76,7 +76,7 @@ subroutine amg_z_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_z_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_z_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_z_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_z_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_z_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_z_lz_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_lz_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()

@@ -142,6 +142,7 @@ subroutine amg_z_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()

@@ -72,7 +72,9 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
  use psb_base_mod
  use amg_base_prec_type
  use amg_z_inner_mod
-
+#if defined(OPENMP)
+  use omp_lib
+#endif
  implicit none

  ! Arguments
@@ -85,7 +87,7 @@ subroutine amg_z_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_dpk_), allocatable  :: val(:), diag(:)
@@ -99,6 +101,9 @@ subroutine amg_z_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_z_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_z_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.zzero)) 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_z_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.zzero)) then
            ip = ip + 1
            icol(ip) = icol(k)
          end if
@@ -194,8 +371,7 @@ subroutine amg_z_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_z_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_z_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_z_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_z_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_z_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_z_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_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
  return

 end subroutine amg_z_soc1_map_bld
-
--- a/Show More
+++ b/Show More
Author	SHA1	Message	Date
sfilippone	1aef82023c	Merge branch 'repackage' of github.com:sfilippone/amg4psblas into repackage	2025-02-09 16:32:40 +01:00
sfilippone	161b93da64	Fix interface issues of clone_settings	2025-02-09 16:02:00 +01:00
Salvatore Filippone	8d4af1ba9f	Fix output formatting bug	2025-01-19 11:15:44 +01:00
sfilippone	cd87bdb0c1	Add call to clean_zeros()	2025-01-08 17:19:58 +01:00
Cirdans-Home	53afa87814	Added row-preserving filtering	2024-12-13 17:19:04 +00:00
sfilippone	13c99a0c3f	Cleanup use of RICHARDSON	2024-11-18 16:20:35 +01:00
sfilippone	1aa7c8db59	Fix release version of UG	2024-11-18 15:53:52 +01:00
sfilippone	36b57eec24	Define 1.2 as name of UG	2024-11-18 15:51:16 +01:00
fdurastante	417f8beaf9	Added remark on polynomial smoothers	2024-11-18 14:42:31 +01:00
fdurastante	d66bf1e2f8	Added remark on polynomial smoothers	2024-11-18 14:41:59 +01:00
sfilippone	c590a4088a	Merge branch 'repackage' of github.com:sfilippone/amg4psblas into repackage	2024-11-18 12:52:39 +01:00
sfilippone	80dfd1ad3b	Modified README	2024-11-18 12:47:39 +01:00
Pasqua D'Ambra	857844474a	Update README.md	2024-11-18 10:56:46 +01:00
fdurastante	a85997926c	Update README.md	2024-11-18 10:08:29 +01:00
fdurastante	70fb39ae55	Added Polynomial Smoother infos	2024-11-18 10:03:21 +01:00
sfilippone	82de529c54	Makefile in amg4psblas/docs	2024-11-18 09:17:11 +01:00
sfilippone	db9757a45e	Update README Fortran 2003 to 2008	2024-11-15 17:28:14 +01:00
fdurastante	5b654cc221	Update README.md	2024-11-15 17:13:17 +01:00
sfilippone	d518f5eac7	Merge branch 'l1-and-0-aggr' into repackage	2024-11-12 10:07:44 +01:00
sfilippone	053d5c4bc0	Changed sample input file	2024-11-11 18:10:34 +01:00
sfilippone	032543d625	Adjusted CBIND test program.	2024-11-11 13:06:48 +01:00
sfilippone	07149a02ad	Fixes for krylov->linsolve. Test program to be completed.	2024-11-11 09:11:07 +01:00
sfilippone	08a0c744b1	Switch from KRYLOV to LINSOLVE	2024-11-10 14:00:51 +01:00
sfilippone	60324084d8	New Richardson solver.	2024-11-08 18:25:13 +01:00
sfilippone	83ba79d7ae	Fix input file	2024-11-02 10:33:23 +01:00
sfilippone	b704d50df1	Fix dump of TPROL and POLY smoother	2024-10-30 10:49:05 +01:00
Cirdans-Home	68a9cceaa0	Fixed l1-Jacobi scaling	2024-10-29 15:51:37 +00:00
Salvatore Filippone	aec5a52c7f	Missing CBIND clean target	2024-10-16 10:56:53 +02:00
Cirdans-Home	8966ecb4a6	First implementation of l1-aggregation	2024-10-09 09:43:43 +00:00
Cirdans-Home	3e9a5c0c5b	Remove diagonal zeros from aggregation	2024-10-04 12:28:36 +00:00
sfilippone	dfc261cf34	Modify error message in smth_bld	2024-09-12 18:45:20 +02:00
sfilippone	cab98295e2	Improve handling of pointers in hierarchy_bld	2024-08-06 10:28:02 +02:00
sfilippone	5a83c63810	Unused lines in ilu_solver_bld	2024-08-02 15:00:44 +02:00
sfilippone	2e43f55455	Update sample/advanced/pdegeb	2024-08-02 15:00:28 +02:00
sfilippone	244fcda207	Update test program input	2024-08-02 13:48:42 +02:00
sfilippone	ca6fce0765	Fix for test program	2024-08-02 13:46:41 +02:00
sfilippone	b6f92354d3	Reworked sample data generation	2024-08-02 12:39:09 +02:00
sfilippone	1b7fe6a9a7	Fix input data in samples pdegen	2024-07-30 09:49:46 +02:00
sfilippone	14ea4d9c15	Fix sample programs for polynomial smoothers	2024-07-29 17:35:01 +02:00
sfilippone	3ee333baac	Change name abgdxyz into upd_xyz	2024-07-29 16:59:59 +02:00
sfilippone	ecb41dfbbf	Update pde3d.inp	2024-07-16 13:41:51 +02:00
sfilippone	33ac3f786b	Merge latest changes from polysmooth	2024-07-16 13:12:10 +02:00
sfilippone	474c6a3634	Merge branch 'PolySmooth' into development	2024-07-05 16:50:26 +02:00
sfilippone	c1e8bc0c57	Do not use OpenMP code for serial version	2024-07-05 14:23:44 +02:00
sfilippone	2f5072166d	Switch off OpenMP in certain sections of MatchBOXP	2024-07-05 13:56:52 +02:00
sfilippone	89e2d53e8b	Silence debug print.	2024-07-05 13:56:38 +02:00
sfilippone	bfe0a32e09	Merge branch 'mboxomp' into PolySmooth	2024-07-05 13:08:56 +02:00
sfilippone	e88d176fed	Switch off OpenMP in processExposedVertex	2024-07-05 12:10:26 +02:00
sfilippone	c96727a97c	Merge branch 'PolySmooth' into mboxomp	2024-07-03 11:01:08 +02:00
sfilippone	6362db0cc5	Try improve OpenMP version of matchbox	2024-07-03 11:00:13 +02:00
sfilippone	9239b16175	Merge branch 'PolySmooth' of github.com:sfilippone/amg4psblas into PolySmooth	2024-07-03 10:58:33 +02:00
sfilippone	96a700cb9d	Workaround for save_smoothers bug with gcc-13.3.0	2024-07-03 10:58:00 +02:00
sfilippone	41d91120d4	Merge branch 'PolySmooth' into mboxomp	2024-06-11 09:57:53 +02:00
sfilippone	5d20407b15	Merge branch 'PolySmooth' of github.com:sfilippone/amg4psblas into PolySmooth	2024-06-11 09:56:39 +02:00
sfilippone	322e3f65d1	Merge branch 'PolySmooth' of github.com:sfilippone/amg4psblas into PolySmooth	2024-06-11 09:55:07 +02:00
sfilippone	3ff1ad9372	Fix noise in %memory_use()	2024-06-11 09:54:55 +02:00
sfilippone	818ead5878	Try changes for matching	2024-06-11 09:52:11 +02:00
sfilippone	803d311d1c	S versions. Take out parallel in a few places	2024-06-06 17:12:31 +02:00
sfilippone	677e4fe6bc	Modify MatchBox names with D in preparation for S version	2024-06-05 15:13:18 +02:00
sfilippone	02a83575a2	Reorganize MatchBox (prepare for S OpenMP)	2024-06-05 13:11:41 +02:00
sfilippone	cfbec1f6ea	Cosmetic changes to MatchBoxPC	2024-06-05 10:38:30 +02:00
sfilippone	e11a134a1f	Additional tinkering with OpenMP matchbox	2024-06-04 17:39:31 +02:00
sfilippone	6d05120930	Merge branch 'PolySmooth' of github.com:sfilippone/amg4psblas into PolySmooth	2024-06-04 16:56:07 +02:00
sfilippone	bd2d1e3b26	Additional OpenMP tinkering in matchboxp	2024-06-04 16:53:52 +02:00
sfilippone	c9605d1b29	Mods for OpenMP	2024-06-04 13:25:12 +02:00
sfilippone	67594f8b07	Fixes for OpenMP	2024-05-30 17:35:15 +02:00
sfilippone	301fb57bb1	Merge branch 'PolySmooth' of github.com:sfilippone/amg4psblas into PolySmooth	2024-05-30 17:26:49 +02:00
sfilippone	13eee99ea3	Use ifdef OPENMP	2024-05-30 17:26:34 +02:00
sfilippone	fb802c62cd	Merge PSBCXXDEFINES into AMGCXXDEFINES	2024-05-30 17:25:25 +02:00
sfilippone	767b606bb2	Do away with -DOMP	2024-05-30 16:14:32 +02:00
sfilippone	8492c07521	Merge PSBCXXDEFINES into CXXDEFINES	2024-05-30 16:14:12 +02:00
sfilippone	17698c2725	Changes to OpenMP MathcBox version needs -DOMP	2024-05-30 14:43:26 +02:00
Salvatore Filippone	897c5229a6	Improve behaviour of OpenMP matching	2024-05-30 08:13:08 -04:00
Salvatore Filippone	ab5eaac5ed	Cosmetic changes	2024-05-30 08:12:48 -04:00
sfilippone	234071869d	Merge branch 'PolySmooth' of github.com:sfilippone/amg4psblas into PolySmooth	2024-05-10 15:03:38 +02:00
sfilippone	3e3b343131	Fix potential overflow issue in SOC_MAP_BLD	2024-05-10 15:02:36 +02:00
Cirdans-Home	5790aa0cbd	Revert "First hardcoded implementation of l1 smooth aggregation" This reverts commit `a17f503486`.	2024-04-26 10:55:47 +00:00
Cirdans-Home	a17f503486	First hardcoded implementation of l1 smooth aggregation	2024-04-26 10:54:43 +00:00
Cirdans-Home	74dccb6c44	Added timers and removed unuseful spmm	2024-04-22 07:52:14 +00:00
sfilippone	e83bde6896	New timings	2024-04-17 14:45:20 +02:00
Salvatore Filippone	83d435b49e	Default GLOBAL=.true. for MEMORY_USE	2024-03-16 15:22:24 +01:00
Salvatore Filippone	af3fda9690	Additional output fixes for memory_use	2024-03-16 14:26:19 +01:00
Salvatore Filippone	678237cf29	Fixed implementation of GLOBAL vs VERBOSITY	2024-03-16 13:31:47 +01:00
Salvatore Filippone	3671285c7a	Modified memory_use impl with GLOBAL and VERBOSITY	2024-03-16 13:15:35 +01:00
sfilippone	a747cc6abb	Defined memory_use method	2024-03-15 15:47:56 +01:00
Cirdans-Home	d385d99e71	Fixed Cheby1 Implementation	2024-03-05 18:43:34 +01:00
Salvatore Filippone	4e6e3d5f09	Fix merge conflict	2024-02-21 16:50:55 +01:00
Salvatore Filippone	7c48b96936	Work version of polynomial smoother	2024-02-21 16:45:59 +01:00
Salvatore Filippone	12478a2fff	Define COARSE_INVFILL	2024-02-21 16:45:53 +01:00
Salvatore Filippone	2ef4459b18	Added "COARSE_INVFILL"	2024-02-21 11:51:18 +01:00
Cirdans-Home	ea8974f88c	Fixed build and apply to actually use degree	2024-02-02 19:25:21 +01:00
Cirdans-Home	54d608d2dd	Isolated under ifdef buggy matching	2024-02-01 14:50:49 +01:00
sfilippone	47bafd7fe7	Add missing file	2023-11-28 14:00:24 +01:00
sfilippone	c2fd0ac66d	Disable MATCHBOX with SERIAL_MPI and add error message	2023-11-26 11:43:10 +01:00
sfilippone	5387e206b1	Fixed sample programs	2023-11-24 16:07:22 +01:00
sfilippone	ccef858192	Cleanup dead code	2023-11-22 14:45:16 +01:00
sfilippone	30a5c7be03	Added POLY smoothers, also in SAMPLES/ADVANCED	2023-11-22 13:33:20 +01:00
sfilippone	737ebb9a96	Test program working	2023-11-21 12:01:07 +01:00
sfilippone	dc15b931a0	New test program.	2023-11-21 11:36:13 +01:00
sfilippone	23aabd794d	Defined new variant of polynomial smoother.	2023-11-20 11:32:51 +01:00
sfilippone	a67454ef5c	Prepare for new variant.	2023-11-17 16:01:52 +01:00
sfilippone	79317cb392	Additional fields for rho(BA) estimate.	2023-11-17 15:35:15 +01:00
sfilippone	847ed6ae60	Estimate rho(BA)	2023-11-17 14:56:51 +01:00
sfilippone	6ad82037c5	Add comments in smoother fields	2023-11-17 14:49:20 +01:00
sfilippone	bee9d63e9c	Take out debug statement	2023-11-17 14:46:22 +01:00
sfilippone	bb262275a1	Temporary checkpoint, working version, to be investigated further.	2023-11-17 14:45:18 +01:00
sfilippone	14cd4cde76	Fix inpout file.	2023-11-17 13:16:41 +01:00
sfilippone	ec9fcb1bcc	Adjustments for POLYNOMIAL smoothers.	2023-11-17 13:14:06 +01:00
sfilippone	2dd1cbd3dc	Fix coeff generation. Change name of polynomial coefficients module.	2023-11-17 13:13:30 +01:00
sfilippone	fc34385341	Fix matrix generation for samples	2023-11-16 17:55:42 +01:00
sfilippone	5fbdfb1436	Fix free for jac_solver	2023-11-16 17:55:24 +01:00
sfilippone	ea2f75776c	Implement structure for polynomial smoother	2023-11-13 16:58:30 +01:00
sfilippone	1dcb542e4a	Include solver_sweeps in test program	2023-10-30 16:10:12 +01:00
sfilippone	84ea60c94c	Defined Jacobi and L1-JACOBI solvers.	2023-10-27 15:49:13 +02:00
sfilippone	e8b50152fa	Fix comments on LOCAL_SOLVER GLOBAL_SOLVER	2023-10-25 15:28:44 +02:00
sfilippone	e6894501dd	Add setting of MUMPS_LOC_GLOB when using MUMPS at lower levels	2023-10-25 15:28:36 +02:00
sfilippone	975fc6265f	Fix spurious free	2023-10-24 18:23:44 +02:00
Salvatore Filippone	a97f56d673	Add L1-JACOBI as subsolver.	2023-10-24 18:01:47 +02:00
sfilippone	b1f05482a6	Add 'DECOUPLED' as possible choice	2023-10-04 10:59:23 +02:00
sfilippone	fb490cee7e	Merge branch 'dev-openmp' into development	2023-09-07 10:15:01 +02:00
Salvatore Filippone	24c85c7114	Merged hierarchy_ and smoothers_ free methods from dev	2023-08-31 08:35:27 -04:00
sfilippone	53998a1da9	Fixed out of bound accesses.	2023-08-28 13:25:53 +02:00
sfilippone	0bcc9d7b55	Merge branch 'dev-openmp' into development	2023-08-22 10:38:25 +02:00
sfilippone	11421f53a2	Minor updates on sample output	2023-08-22 10:36:44 +02:00
sfilippone	d33bcfe107	Completed SOC2 OpenMP.	2023-08-13 09:52:25 +02:00
sfilippone	5bcd36f394	Fixed SOC1 and SOC2 OpenMP	2023-08-08 09:25:15 +02:00
sfilippone	73495edf09	Finish SOC1 OpenMP	2023-08-07 08:59:32 +02:00
sfilippone	9e82d2e311	Final OMP version of SOC1.	2023-08-04 09:30:32 +02:00
sfilippone	c1ecb4ebec	Fixed SOC1 and begin work on SOC2	2023-08-03 13:26:24 +02:00
sfilippone	e78449d0f5	Prepare for SOC2 OpenMP	2023-07-31 13:26:05 +02:00
sfilippone	e3de565b6d	Updated commeents in SOC1	2023-07-26 14:47:05 +02:00
sfilippone	7b9c722a1a	Fixed OpenMP version of SOC1.	2023-07-26 14:32:13 +02:00
sfilippone	2fd718be6f	Updates and measurements for OpenMP build	2023-07-19 15:59:11 +02:00
sfilippone	3a5e73e4c8	adjust NTH in samples/pdegen	2023-06-14 14:05:42 +02:00
sfilippone	dd7cb86775	Fix clone_settings for AINV variants.	2023-04-11 10:44:20 +02:00
sfilippone	e1789b35bb	Make sure to use install -p	2023-03-30 15:52:17 +02:00
Salvatore Filippone	426215044a	Fix configry: do not put extra white spaces before SLU_LIBS etc	2022-12-07 10:14:05 +01:00
Salvatore Filippone	eee0cdb577	Fix configry: do not put extra white spaces after SLU_LIBS etc	2022-12-07 09:32:47 +01:00
Salvatore Filippone	92e0fd7f19	Modified precset to warn about overriding COARSE_MAT	2022-12-02 07:15:30 -05:00
Salvatore Filippone	bccde3a8b0	Merge branch 'development' of github.com:sfilippone/amg4psblas into development	2022-11-28 12:09:24 -05:00
Salvatore Filippone	e6d7f48fdf	Defined smoothers_free method	2022-11-28 12:08:33 -05:00
Salvatore Filippone	8c84ba2464	Fix gitignore	2022-10-29 08:45:32 +02:00