Defined Jacobi and L1-JACOBI solvers.

(Might have solved stucked runs)

.gitignore

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

Changelog

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

LICENSE

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

Makefile

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

README.md

@@ -1,6 +1,5 @@
-
                          AMG4PSBLAS  
- Algebraic Multigrid Package  based on PSBLAS (Parallel Sparse BLAS version 3.7)
+ 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)

amgprec/Makefile

@@ -11,7 +11,7 @@ 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_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 \
@@ -22,7 +22,7 @@ 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_base_solver_mod.o amg_s_base_smoother_mod.o amg_s_onelev_mod.o  \
-	amg_s_gs_solver.o amg_s_mumps_solver.o \
+	amg_s_gs_solver.o amg_s_mumps_solver.o  amg_s_jac_solver.o \
 	amg_s_base_aggregator_mod.o  \
 	amg_s_dec_aggregator_mod.o amg_s_symdec_aggregator_mod.o \
 	amg_s_ainv_solver.o amg_s_base_ainv_mod.o \
@@ -33,7 +33,7 @@ ZMODOBJS=amg_z_prec_type.o amg_z_ilu_fact_mod.o \
 	amg_z_inner_mod.o amg_z_ilu_solver.o amg_z_diag_solver.o amg_z_jac_smoother.o amg_z_as_smoother.o \
 	amg_z_umf_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o amg_z_id_solver.o\
 	amg_z_base_solver_mod.o amg_z_base_smoother_mod.o amg_z_onelev_mod.o \
-	amg_z_gs_solver.o amg_z_mumps_solver.o \
+	amg_z_gs_solver.o amg_z_mumps_solver.o  amg_z_jac_solver.o \
 	amg_z_base_aggregator_mod.o  \
 	amg_z_dec_aggregator_mod.o amg_z_symdec_aggregator_mod.o \
 	amg_z_ainv_solver.o amg_z_base_ainv_mod.o \
@@ -43,7 +43,7 @@ CMODOBJS=amg_c_prec_type.o amg_c_ilu_fact_mod.o \
 	amg_c_inner_mod.o amg_c_ilu_solver.o amg_c_diag_solver.o amg_c_jac_smoother.o amg_c_as_smoother.o \
 	amg_c_slu_solver.o amg_c_id_solver.o\
 	amg_c_base_solver_mod.o amg_c_base_smoother_mod.o amg_c_onelev_mod.o  \
-	amg_c_gs_solver.o amg_c_mumps_solver.o \
+	amg_c_gs_solver.o amg_c_mumps_solver.o  amg_c_jac_solver.o \
 	amg_c_base_aggregator_mod.o  \
 	amg_c_dec_aggregator_mod.o amg_c_symdec_aggregator_mod.o \
 	amg_c_ainv_solver.o amg_c_base_ainv_mod.o \
@@ -62,17 +62,20 @@ OBJS=$(MODOBJS)
 LOCAL_MODS=$(MODOBJS:.o=$(.mod))
 LIBNAME=libamg_prec.a
 
-all: lib impld
+all: objs impld
 
-impld: $(OBJS)
+objs: $(OBJS)
-	$(MAKE) -C impl
+	/bin/cp -p amg_const.h $(INCDIR)
+	/bin/cp -p *$(.mod) $(MODDIR)
+
+impld: objs
+	cd impl && $(MAKE) 
 
 lib: $(OBJS) impld
+	cd impl && $(MAKE) lib
 	$(AR) $(HERE)/$(LIBNAME) $(OBJS)
 	$(RANLIB) $(HERE)/$(LIBNAME)
 	/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
-	/bin/cp -p amg_const.h $(INCDIR)
-	/bin/cp -p *$(.mod) $(MODDIR)
 
 
 $(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
@@ -152,7 +155,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
@@ -163,7 +166,7 @@ amg_dprecinit.o amg_dprecset.o: amg_d_diag_solver.o amg_d_ilu_solver.o \
 	        amg_d_id_solver.o amg_d_slu_solver.o amg_d_sludist_solver.o
 
 amg_s_mumps_solver.o amg_s_gs_solver.o amg_s_id_solver.o amg_s_slu_solver.o \
-amg_s_diag_solver.o amg_s_ilu_solver.o: amg_s_base_solver_mod.o  amg_s_prec_type.o
+amg_s_diag_solver.o amg_s_ilu_solver.o amg_s_jac_solver.o: amg_s_base_solver_mod.o  amg_s_prec_type.o
 amg_s_ilu_fact_mod.o: amg_base_prec_type.o  amg_s_base_solver_mod.o
 amg_s_ilu_solver.o amg_s_iluk_fact.o: amg_s_ilu_fact_mod.o
 amg_s_as_smoother.o amg_s_jac_smoother.o: amg_s_base_smoother_mod.o
@@ -173,7 +176,7 @@ amg_sprecinit.o amg_sprecset.o: amg_s_diag_solver.o amg_s_ilu_solver.o \
 	        amg_s_id_solver.o amg_s_slu_solver.o
 
 amg_z_mumps_solver.o amg_z_gs_solver.o amg_z_id_solver.o amg_z_sludist_solver.o amg_z_slu_solver.o \
-amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o: amg_z_base_solver_mod.o  amg_z_prec_type.o
+amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o amg_z_jac_solver.o: amg_z_base_solver_mod.o  amg_z_prec_type.o
 amg_z_ilu_fact_mod.o: amg_base_prec_type.o  amg_z_base_solver_mod.o
 amg_z_ilu_solver.o amg_z_iluk_fact.o: amg_z_ilu_fact_mod.o
 amg_z_as_smoother.o amg_z_jac_smoother.o: amg_z_base_smoother_mod.o
@@ -183,7 +186,7 @@ amg_zprecinit.o amg_zprecset.o: amg_z_diag_solver.o amg_z_ilu_solver.o \
 	        amg_z_id_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o
 
 amg_c_mumps_solver.o amg_c_gs_solver.o amg_c_id_solver.o amg_c_sludist_solver.o amg_c_slu_solver.o \
-amg_c_diag_solver.o amg_c_ilu_solver.o: amg_c_base_solver_mod.o  amg_c_prec_type.o
+amg_c_diag_solver.o amg_c_ilu_solver.o amg_c_jac_solver.o: amg_c_base_solver_mod.o  amg_c_prec_type.o
 amg_c_ilu_fact_mod.o: amg_base_prec_type.o  amg_c_base_solver_mod.o
 amg_c_ilu_solver.o amg_c_iluk_fact.o: amg_c_ilu_fact_mod.o
 amg_c_as_smoother.o amg_c_jac_smoother.o: amg_c_base_smoother_mod.o
@@ -218,4 +221,4 @@ clean: implclean
 	/bin/rm -f $(OBJS) $(LOCAL_MODS) *$(.mod)
 
 implclean:
-	$(MAKE) -C impl clean
+	cd impl && $(MAKE) clean

amgprec/amg_base_prec_type.F90

@@ -64,7 +64,7 @@ module amg_base_prec_type
   !
   use psb_const_mod
   use psb_base_mod, only :&
-       & psb_desc_type, psb_i_vect_type, psb_i_base_vect_type,&
+       & psb_desc_type, psb_ctxt_type,&
        & psb_ipk_, psb_dpk_, psb_spk_, psb_epk_,  &
        & psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, &
        & psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,&
@@ -81,9 +81,9 @@ module amg_base_prec_type
   !
   ! Version numbers
   !
-  character(len=*), parameter   :: amg_version_string_ = "1.0.0"
+  character(len=*), parameter   :: amg_version_string_ = "1.1.0"
   integer(psb_ipk_), parameter  :: amg_version_major_  = 1
-  integer(psb_ipk_), parameter  :: amg_version_minor_  = 0
+  integer(psb_ipk_), parameter  :: amg_version_minor_  = 1
   integer(psb_ipk_), parameter  :: amg_patchlevel_     = 0
 
   type amg_ml_parms
@@ -94,6 +94,7 @@ module amg_base_prec_type
     integer(psb_ipk_) :: aggr_omega_alg, aggr_eig, aggr_filter
     integer(psb_ipk_) :: coarse_mat, coarse_solve
   contains
+    procedure, pass(pm) :: get_coarse_mat  => ml_parms_get_coarse_mat
     procedure, pass(pm) :: get_coarse  => ml_parms_get_coarse
     procedure, pass(pm) :: clone       => ml_parms_clone
     procedure, pass(pm) :: descr       => ml_parms_descr
@@ -577,6 +578,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
@@ -649,43 +677,52 @@ contains
     end if
   end subroutine ml_parms_mlcycledsc
 
-  subroutine ml_parms_mldescr(pm,iout,info)
+  subroutine ml_parms_mldescr(pm,iout,info,prefix)
 
     Implicit None
 
     ! Arguments
-    class(amg_ml_parms), intent(in) :: pm
+    class(amg_ml_parms), intent(in)        :: pm
-    integer(psb_ipk_), intent(in)             :: iout
+    integer(psb_ipk_), intent(in)          :: iout
-    integer(psb_ipk_), intent(out)            :: info
+    integer(psb_ipk_), intent(out)         :: info
+    character(len=*), intent(in), optional :: prefix
+
+    character(1024)  :: prefix_ 
     info = psb_success_
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+    
     if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then
 
 
-      write(iout,*) '  Parallel aggregation algorithm: ',&
+      write(iout,*) trim(prefix),'  Parallel aggregation algorithm: ',&
            &   par_aggr_alg_names(pm%par_aggr_alg)
-      if (pm%aggr_type>0) write(iout,*) '  Aggregation type: ',&
+      if (pm%aggr_type>0) write(iout,*) trim(prefix),'  Aggregation type: ',&
            & aggr_type_names(pm%aggr_type)
       !if (pm%par_aggr_alg /= amg_ext_aggr_) then
         if ( pm%aggr_ord /= amg_aggr_ord_nat_) &
-             & write(iout,*) '               with initial ordering: ',&
+             & write(iout,*) trim(prefix),'               with initial ordering: ',&
              &   ord_names(pm%aggr_ord)
-        write(iout,*) '  Aggregation prolongator: ', &
+        write(iout,*) trim(prefix),'  Aggregation prolongator: ', &
              &  aggr_prols(pm%aggr_prol)
         if (pm%aggr_prol /= amg_no_smooth_) then
-          write(iout,*) '              with: ', aggr_filters(pm%aggr_filter)
+          write(iout,*) trim(prefix),'              with: ', aggr_filters(pm%aggr_filter)
           if (pm%aggr_omega_alg == amg_eig_est_) then
-            write(iout,*) '  Damping omega computation: spectral radius estimate'
+            write(iout,*) trim(prefix),'  Damping omega computation: spectral radius estimate'
-            write(iout,*) '  Spectral radius estimate: ', &
+            write(iout,*) trim(prefix),'  Spectral radius estimate: ', &
                  & eigen_estimates(pm%aggr_eig)
           else if (pm%aggr_omega_alg == amg_user_choice_) then
-            write(iout,*) '  Damping omega computation: user defined value.'
+            write(iout,*) trim(prefix),'  Damping omega computation: user defined value.'
           else
-            write(iout,*) '  Damping omega computation: unknown value in iprcparm!!'
+            write(iout,*) trim(prefix),'  Damping omega computation: unknown value in iprcparm!!'
           end if
         end if
       !end if
     else
-      write(iout,*) '  Multilevel type: Unkonwn value. Something is amiss....',&
+      write(iout,*) trim(prefix),'  Multilevel type: Unkonwn value. Something is amiss....',&
            & pm%ml_cycle
     end if
 
@@ -693,15 +730,16 @@ contains
 
   end subroutine ml_parms_mldescr
 
-  subroutine ml_parms_descr(pm,iout,info,coarse)
+  subroutine ml_parms_descr(pm,iout,info,coarse,prefix)
 
     Implicit None
 
     ! Arguments
-    class(amg_ml_parms), intent(in) :: pm
+    class(amg_ml_parms), intent(in)        :: pm
-    integer(psb_ipk_), intent(in)             :: iout
+    integer(psb_ipk_), intent(in)          :: iout
-    integer(psb_ipk_), intent(out)            :: info
+    integer(psb_ipk_), intent(out)         :: info
-    logical, intent(in), optional   :: coarse
+    logical, intent(in), optional          :: coarse
+    character(len=*), intent(in), optional :: prefix
     logical :: coarse_
 
     info = psb_success_
@@ -712,7 +750,7 @@ contains
     end if
 
     if (coarse_) then
-      call pm%coarsedescr(iout,info)
+      call pm%coarsedescr(iout,info,prefix=prefix)
     end if
 
     return
@@ -720,81 +758,126 @@ contains
   end subroutine ml_parms_descr
 
 
-  subroutine ml_parms_coarsedescr(pm,iout,info)
+  subroutine ml_parms_coarsedescr(pm,iout,info,prefix)
 
 
     Implicit None
 
     ! Arguments
-    class(amg_ml_parms), intent(in) :: pm
+    class(amg_ml_parms), intent(in)       :: pm
-    integer(psb_ipk_), intent(in)             :: iout
+    integer(psb_ipk_), intent(in)         :: iout
-    integer(psb_ipk_), intent(out)            :: info
+    integer(psb_ipk_), intent(out)        :: info
+    character(len=*), intent(in), optional :: prefix
+
+    character(1024)  :: prefix_ 
 
     info = psb_success_
-    write(iout,*) '  Coarse matrix: ',&
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout,*) trim(prefix),'  Coarse matrix: ',&
          & matrix_names(pm%coarse_mat)
     select case(pm%coarse_solve)
     case (amg_bjac_,amg_as_)
-      write(iout,*) '  Number of sweeps : ',&
+      write(iout,*) trim(prefix),'  Coarse solver: ',&
-           & pm%sweeps_pre
-      write(iout,*) '  Coarse solver: ',&
            & 'Block Jacobi'
+      write(iout,*) trim(prefix),'  Number of sweeps : ',&
+           & pm%sweeps_pre
     case (amg_l1_bjac_)
-      write(iout,*) '  Number of sweeps : ',&
+      write(iout,*) trim(prefix),'  Coarse solver: ',&
-           & pm%sweeps_pre
-      write(iout,*) '  Coarse solver: ',&
            & 'L1-Block Jacobi'
-    case (amg_jac_)
+      write(iout,*) trim(prefix),'  Number of sweeps : ',&
-      write(iout,*) '  Number of sweeps : ',&
            & pm%sweeps_pre
-      write(iout,*) '  Coarse solver: ',&
+    case (amg_jac_)
+      write(iout,*) trim(prefix),'  Coarse solver: ',&
            & 'Point Jacobi'
+      write(iout,*) trim(prefix),'  Number of sweeps : ',&
+           & pm%sweeps_pre
+    case (amg_l1_jac_)
+      write(iout,*) trim(prefix),'  Coarse solver: ',&
+           & 'L1-Jacobi'
+      write(iout,*) trim(prefix),'  Number of sweeps : ',&
+           & pm%sweeps_pre
+    case (amg_l1_fbgs_)
+      write(iout,*) trim(prefix),'  Coarse solver: ',&
+           & 'L1 Forward-Backward Gauss-Seidel (Hybrid)'
+      write(iout,*) trim(prefix),'  Number of sweeps : ',&
+           & pm%sweeps_pre
+    case (amg_l1_gs_)
+      write(iout,*) trim(prefix),'  Coarse solver: ',&
+           & 'L1 Gauss-Seidel (Hybrid)'
+      write(iout,*) trim(prefix),'  Number of sweeps : ',&
+           & pm%sweeps_pre
+    case (amg_fbgs_)
+      write(iout,*) trim(prefix),'  Coarse solver: ',&
+           & 'Forward-Backward Gauss-Seidel (Hybrid)'
+      write(iout,*) trim(prefix),'  Number of sweeps : ',&
+           & pm%sweeps_pre
     case default
-      write(iout,*) '  Coarse solver: ',&
+      write(iout,*) trim(prefix),'  Coarse solver: ',&
            & amg_fact_names(pm%coarse_solve)
     end select
-
+    
   end subroutine ml_parms_coarsedescr
 
-  subroutine s_ml_parms_descr(pm,iout,info,coarse)
+  subroutine s_ml_parms_descr(pm,iout,info,coarse,prefix)
 
     Implicit None
 
     ! Arguments
-    class(amg_sml_parms), intent(in) :: pm
+    class(amg_sml_parms), intent(in)       :: pm
-    integer(psb_ipk_), intent(in)             :: iout
+    integer(psb_ipk_), intent(in)          :: iout
-    integer(psb_ipk_), intent(out)            :: info
+    integer(psb_ipk_), intent(out)         :: info
-    logical, intent(in), optional   :: coarse
+    logical, intent(in), optional          :: coarse
+    character(len=*), intent(in), optional :: prefix
+
+    character(1024)  :: prefix_ 
 
     info = psb_success_
-
+    if (present(prefix)) then
-    call pm%amg_ml_parms%descr(iout,info,coarse)
+      prefix_ = prefix
-    if (pm%aggr_prol /= amg_no_smooth_) then
+    else
-      write(iout,*) '  Damping omega value  :',pm%aggr_omega_val
+      prefix_ = ""
     end if
-    write(iout,*) '  Aggregation threshold:',pm%aggr_thresh
+
+    call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix)
+    if (pm%aggr_prol /= amg_no_smooth_) then
+      write(iout,*) trim(prefix),'  Damping omega value  :',pm%aggr_omega_val
+    end if
+    write(iout,*) trim(prefix),'  Aggregation threshold:',pm%aggr_thresh
 
     return
 
   end subroutine s_ml_parms_descr
 
-  subroutine d_ml_parms_descr(pm,iout,info,coarse)
+  subroutine d_ml_parms_descr(pm,iout,info,coarse,prefix)
 
     Implicit None
 
     ! Arguments
-    class(amg_dml_parms), intent(in) :: pm
+    class(amg_dml_parms), intent(in)       :: pm
-    integer(psb_ipk_), intent(in)             :: iout
+    integer(psb_ipk_), intent(in)          :: iout
-    integer(psb_ipk_), intent(out)            :: info
+    integer(psb_ipk_), intent(out)         :: info
-    logical, intent(in), optional   :: coarse
+    logical, intent(in), optional          :: coarse
+    character(len=*), intent(in), optional :: prefix
+
+    character(1024)  :: prefix_ 
 
     info = psb_success_
-
+    if (present(prefix)) then
-    call pm%amg_ml_parms%descr(iout,info,coarse)
+      prefix_ = prefix
-    if (pm%aggr_prol /= amg_no_smooth_) then
+    else
-      write(iout,*) '  Damping omega value  :',pm%aggr_omega_val
+      prefix_ = ""
     end if
-    write(iout,*) '  Aggregation threshold:',pm%aggr_thresh
+
+    call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix)
+    if (pm%aggr_prol /= amg_no_smooth_) then
+      write(iout,*) trim(prefix),'  Damping omega value  :',pm%aggr_omega_val
+    end if
+    write(iout,*) trim(prefix),'  Aggregation threshold:',pm%aggr_thresh
 
     return
 

amgprec/amg_c_ainv_solver.F90

@@ -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), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_c_ainv_solver_clone_settings
+  end interface
 
   interface
     subroutine amg_c_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
@@ -198,7 +209,7 @@ module amg_c_ainv_solver
 !!$  end interface
 
   interface
-    subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse)
+    subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
 
       Implicit None
@@ -208,7 +219,7 @@ module amg_c_ainv_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-
+      character(len=*), intent(in), optional  :: prefix
     end subroutine amg_c_ainv_solver_descr
   end interface
 

amgprec/amg_c_as_smoother.f90

@@ -396,21 +396,23 @@ contains
   end subroutine c_as_smoother_default
 
 
-  subroutine c_as_smoother_descr(sm,info,iout,coarse)
+  subroutine c_as_smoother_descr(sm,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_c_as_smoother_type), intent(in) :: sm
-    integer(psb_ipk_), intent(out)                      :: info
+    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional             :: iout
+    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional             :: coarse
+    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_as_smoother_descr'
     integer(psb_ipk_) :: iout_
     logical      :: coarse_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -424,16 +426,21 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (.not.coarse_) then 
-      write(iout_,*) '  Additive Schwarz with  ',&
+      write(iout_,*) trim(prefix_), '  Additive Schwarz with  ',&
            &  sm%novr, ' overlap layers.'
-      write(iout_,*) '  Restrictor:  ',restrict_names(sm%restr)
+      write(iout_,*) trim(prefix_), '  Restrictor:  ',restrict_names(sm%restr)
-      write(iout_,*) '  Prolongator: ',prolong_names(sm%prol)
+      write(iout_,*) trim(prefix_), '  Prolongator: ',prolong_names(sm%prol)
-      write(iout_,*) '  Local solver:'
+      write(iout_,*) trim(prefix_), '  Local solver:'
     endif
     if (allocated(sm%sv)) then 
-      call sm%sv%descr(info,iout_,coarse=coarse)
+      call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
     end if
 
     call psb_erractionrestore(err_act)

amgprec/amg_c_base_aggregator_mod.f90

@@ -275,15 +275,22 @@ contains
     val = .false.
   end function amg_c_base_aggregator_xt_desc
 
-  subroutine  amg_c_base_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_c_base_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none 
     class(amg_c_base_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
+    character(1024)    :: prefix_
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info)
+    call parms%mldescr(iout,info,prefix=prefix)
     
     return
   end subroutine amg_c_base_aggregator_descr

amgprec/amg_c_base_smoother_mod.f90

@@ -272,7 +272,7 @@ module amg_c_base_smoother_mod
   end interface
   
   interface 
-    subroutine amg_c_base_smoother_descr(sm,info,iout,coarse)
+    subroutine amg_c_base_smoother_descr(sm,info,iout,coarse,prefix)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
            & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
            & amg_c_base_smoother_type, psb_ipk_
@@ -281,6 +281,7 @@ module amg_c_base_smoother_mod
       integer(psb_ipk_), intent(out)                :: info
       integer(psb_ipk_), intent(in), optional       :: iout
       logical, intent(in), optional                 :: coarse
+      character(len=*), intent(in), optional        :: prefix
     end subroutine amg_c_base_smoother_descr
   end interface
   

amgprec/amg_c_base_solver_mod.f90

@@ -270,7 +270,7 @@ module amg_c_base_solver_mod
   end interface
   
   interface
-    subroutine amg_c_base_solver_descr(sv,info,iout,coarse)
+    subroutine amg_c_base_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
            & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
            & amg_c_base_solver_type, psb_ipk_
@@ -281,7 +281,7 @@ module amg_c_base_solver_mod
       integer(psb_ipk_), intent(out)              :: info
       integer(psb_ipk_), intent(in), optional     :: iout
       logical, intent(in), optional               :: coarse
-
+      character(len=*), intent(in), optional      :: prefix
     end subroutine amg_c_base_solver_descr
   end interface 
   

amgprec/amg_c_dec_aggregator_mod.f90

@@ -184,16 +184,23 @@ contains
     val = "Decoupled aggregation"
   end function amg_c_dec_aggregator_fmt
   
-  subroutine  amg_c_dec_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_c_dec_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none 
     class(amg_c_dec_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
+    character(1024)    :: prefix_
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout,*) 'Decoupled Aggregator'
+    write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info)
+    call parms%mldescr(iout,info,prefix=prefix)
     
     return
   end subroutine amg_c_dec_aggregator_descr

amgprec/amg_c_diag_solver.f90

@@ -219,7 +219,7 @@ contains
 
   end subroutine c_diag_solver_free
 
-  subroutine c_diag_solver_descr(sv,info,iout,coarse)
+  subroutine c_diag_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -228,11 +228,13 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
+    character(len=*), intent(in), optional      :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_c_diag_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -240,8 +242,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    
+    if (present(prefix)) then
-    write(iout_,*) '  Diagonal local solver '
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout_,*) trim(prefix_), '  Diagonal local solver '
 
     return
 
@@ -352,7 +359,7 @@ module amg_c_l1_diag_solver
   
 contains
 
-  subroutine c_l1_diag_solver_descr(sv,info,iout,coarse)
+  subroutine c_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -361,11 +368,13 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
+    character(len=*), intent(in), optional  :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_c_l1_diag_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -373,8 +382,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    
+    if (present(prefix)) then
-    write(iout_,*) '  L1 Diagonal solver '
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout_,*) trim(prefix_), '  L1 Diagonal solver '
 
     return
 

amgprec/amg_c_gs_solver.f90

@@ -433,20 +433,22 @@ contains
     return
   end subroutine c_gs_solver_free
 
-  subroutine c_gs_solver_descr(sv,info,iout,coarse)
+  subroutine c_gs_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_c_gs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional    :: iout
+    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional       :: coarse
+    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_gs_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -455,12 +457,17 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     
@@ -526,20 +533,22 @@ contains
     val = .true.
   end function c_gs_solver_is_iterative
     
-  subroutine c_bwgs_solver_descr(sv,info,iout,coarse)
+  subroutine c_bwgs_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_c_bwgs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional    :: iout
+    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional       :: coarse
+    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_bwgs_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -548,12 +557,17 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     

amgprec/amg_c_id_solver.f90

@@ -157,7 +157,7 @@ contains
     return
   end subroutine c_id_solver_free
 
-  subroutine c_id_solver_descr(sv,info,iout,coarse)
+  subroutine c_id_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -165,12 +165,14 @@ contains
     class(amg_c_id_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)            :: info
     integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional       :: coarse
+    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_id_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -178,8 +180,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
     
-    write(iout_,*) '  Identity local solver '
+    write(iout_,*) trim(prefix_), '  Identity local solver '
 
     return
 

amgprec/amg_c_ilu_solver.f90

@@ -406,7 +406,7 @@ contains
     return
   end subroutine c_ilu_solver_free
 
-  subroutine c_ilu_solver_descr(sv,info,iout,coarse)
+  subroutine c_ilu_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -414,12 +414,14 @@ contains
     class(amg_c_ilu_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional       :: coarse
+    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_ilu_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -428,15 +430,20 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout_,*) '  Incomplete factorization solver: ',&
+    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_)      
-      write(iout_,*) '  Fill level:',sv%fill_in
+      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
     case(psb_ilu_t_)         
-      write(iout_,*) '  Fill level:',sv%fill_in
+      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-      write(iout_,*) '  Fill threshold :',sv%thresh
+      write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
     end select
 
     call psb_erractionrestore(err_act)

amgprec/amg_c_invk_solver.f90

@@ -52,6 +52,7 @@ module amg_c_invk_solver
   contains
     procedure, pass(sv) :: check   => amg_c_invk_solver_check
     procedure, pass(sv) :: clone   => amg_c_invk_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_c_invk_solver_clone_settings
     procedure, pass(sv) :: build   => amg_c_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_c_invk_solver_cseti
     procedure, pass(sv) :: descr   => amg_c_invk_solver_descr
@@ -73,6 +74,17 @@ module amg_c_invk_solver
     end subroutine amg_c_invk_solver_clone
   end interface
 
+  interface
+    subroutine amg_c_invk_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
+       & amg_c_base_solver_type, psb_spk_, amg_c_invk_solver_type, psb_ipk_
+      Implicit None
+      class(amg_c_invk_solver_type), intent(inout)              :: sv
+      class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_c_invk_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_c_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
@@ -123,7 +135,7 @@ module amg_c_invk_solver
   end interface
 
   interface
-    subroutine amg_c_invk_solver_descr(sv,info,iout,coarse)
+    subroutine amg_c_invk_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_spk_, amg_c_invk_solver_type, psb_ipk_
 
       Implicit None
@@ -133,7 +145,7 @@ module amg_c_invk_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-
+      character(len=*), intent(in), optional  :: prefix
     end subroutine amg_c_invk_solver_descr
   end interface
 

amgprec/amg_c_invt_solver.f90

@@ -52,6 +52,7 @@ module amg_c_invt_solver
   contains
     procedure, pass(sv) :: check   => amg_c_invt_solver_check
     procedure, pass(sv) :: clone   => amg_c_invt_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_c_invt_solver_clone_settings
     procedure, pass(sv) :: build   => amg_c_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_c_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_c_invt_solver_csetr
@@ -73,6 +74,17 @@ module amg_c_invt_solver
     end subroutine amg_c_invt_solver_clone
   end interface
 
+  interface
+    subroutine amg_c_invt_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
+       & amg_c_base_solver_type, psb_spk_, amg_c_invt_solver_type, psb_ipk_
+      Implicit None
+      class(amg_c_invt_solver_type), intent(inout)              :: sv
+      class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_c_invt_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_c_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
@@ -134,16 +146,17 @@ module amg_c_invt_solver
   end interface
 
   interface
-    subroutine amg_c_invt_solver_descr(sv,info,iout,coarse)
+    subroutine amg_c_invt_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_spk_, amg_c_invt_solver_type, psb_ipk_
 
       Implicit None
 
       ! Arguments
       class(amg_c_invt_solver_type), intent(in) :: sv
-      integer(psb_ipk_), intent(out)            :: info
+      integer(psb_ipk_), intent(out)              :: info
-      integer(psb_ipk_), intent(in), optional   :: iout
+      integer(psb_ipk_), intent(in), optional     :: iout
-      logical, intent(in), optional             :: coarse
+      logical, intent(in), optional               :: coarse
+      character(len=*), intent(in), optional      :: prefix
 
     end subroutine amg_c_invt_solver_descr
   end interface

amgprec/amg_c_jac_smoother.f90

@@ -219,12 +219,13 @@ module amg_c_jac_smoother
   end interface
 
   interface
-    subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse)
+    subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse,prefix)
       import :: amg_c_jac_smoother_type, psb_ipk_
       class(amg_c_jac_smoother_type), intent(in) :: sm
       integer(psb_ipk_), intent(out)               :: info
       integer(psb_ipk_), intent(in), optional      :: iout
-      logical, intent(in), optional              :: coarse
+      logical, intent(in), optional                :: coarse
+      character(len=*), intent(in), optional       :: prefix
     end subroutine amg_c_jac_smoother_descr
   end interface
 
@@ -313,12 +314,13 @@ module amg_c_jac_smoother
   end interface
 
   interface
-    subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse)
+    subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
       import :: amg_c_l1_jac_smoother_type, psb_ipk_
       class(amg_c_l1_jac_smoother_type), intent(in) :: sm
-      integer(psb_ipk_), intent(out)               :: info
+      integer(psb_ipk_), intent(out)                  :: info
-      integer(psb_ipk_), intent(in), optional      :: iout
+      integer(psb_ipk_), intent(in), optional         :: iout
-      logical, intent(in), optional              :: coarse
+      logical, intent(in), optional                   :: coarse
+      character(len=*), intent(in), optional          :: prefix
     end subroutine amg_c_l1_jac_smoother_descr
   end interface
 

amgprec/amg_c_jac_solver.f90

@@ -0,0 +1,582 @@
+!  
+!   
+!                             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()
+    call sv%dv%free(info)
+    if (allocated(sv%d)) deallocate(sv%d)
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine c_jac_solver_free
+
+  subroutine c_jac_solver_descr(sv,info,iout,coarse,prefix)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_c_jac_solver_type), intent(in) :: sv
+    integer(psb_ipk_), intent(out)            :: info
+    integer(psb_ipk_), intent(in), optional   :: iout
+    logical, intent(in), optional             :: coarse
+    character(len=*), intent(in), optional    :: prefix
+
+    ! Local variables
+    integer(psb_ipk_)      :: err_act
+    character(len=20), parameter :: name='amg_c_jac_solver_descr'
+    integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+    if (present(iout)) then 
+      iout_ = iout 
+    else
+      iout_ = psb_out_unit
+    endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    if (sv%eps<=dzero) then 
+      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  ',&
+           &  sv%sweeps,' sweeps'
+    else
+      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  tolerance',&
+           &  sv%eps,' and maxit', sv%sweeps
+    end if
+    
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine c_jac_solver_descr
+
+  function c_jac_solver_get_nzeros(sv) result(val)
+
+    implicit none 
+    ! Arguments
+    class(amg_c_jac_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+    integer(psb_ipk_)        :: i
+    
+    val = 0 
+    val = val + sv%a%get_nzeros()
+    val = val + sv%dv%get_nrows()
+
+    return
+  end function c_jac_solver_get_nzeros
+
+  function c_jac_solver_sizeof(sv) result(val)
+
+    implicit none 
+    ! Arguments
+    class(amg_c_jac_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+    integer(psb_ipk_)        :: i
+
+    val = psb_sizeof_ip 
+    val = val + sv%a%sizeof()
+    val = val + sv%dv%sizeof()
+
+    return
+  end function c_jac_solver_sizeof
+
+  function c_jac_solver_get_fmt() result(val)
+    implicit none 
+    character(len=32)  :: val
+
+    val = "Jacobi solver"
+  end function c_jac_solver_get_fmt
+
+  function c_jac_solver_get_id() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = amg_jac_
+  end function c_jac_solver_get_id
+
+  !
+  ! If this is true, then the solver needs a starting
+  ! guess. Currently only handled in JAC smoother. 
+  ! 
+  function c_jac_solver_is_iterative() result(val)
+    implicit none 
+    logical  :: val
+
+    val = .true.
+  end function c_jac_solver_is_iterative
+    
+  function c_jac_solver_get_wrksize() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = 2
+  end function c_jac_solver_get_wrksize
+
+  subroutine c_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_c_l1_jac_solver_type), intent(in) :: sv
+    integer(psb_ipk_), intent(out)            :: info
+    integer(psb_ipk_), intent(in), optional   :: iout
+    logical, intent(in), optional             :: coarse
+    character(len=*), intent(in), optional    :: prefix
+
+    ! Local variables
+    integer(psb_ipk_)      :: err_act
+    character(len=20), parameter :: name='amg_c_l1_jac_solver_descr'
+    integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+    if (present(iout)) then 
+      iout_ = iout 
+    else
+      iout_ = psb_out_unit
+    endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    if (sv%eps<=dzero) then 
+      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  ',&
+           &  sv%sweeps,' sweeps'
+    else
+      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  tolerance',&
+           &  sv%eps,' and maxit', sv%sweeps
+    end if
+    
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine c_l1_jac_solver_descr
+
+  function c_l1_jac_solver_get_fmt() result(val)
+    implicit none 
+    character(len=32)  :: val
+
+    val = "L1-Jacobi solver"
+  end function c_l1_jac_solver_get_fmt
+
+  function c_l1_jac_solver_get_id() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = amg_l1_jac_
+  end function c_l1_jac_solver_get_id
+  
+end module amg_c_jac_solver

amgprec/amg_c_krm_solver.f90

@@ -436,7 +436,7 @@ contains
     val = "KRM solver"
   end function c_krm_solver_get_fmt
 
-  subroutine c_krm_solver_descr(sv,info,iout,coarse)
+  subroutine c_krm_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -444,12 +444,14 @@ contains
     class(amg_c_krm_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional       :: coarse
+    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_krm_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -458,23 +460,22 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (sv%global) then
-      write(iout_,*) '  Krylov solver (global)'
+      write(iout_,*) trim(prefix_), '  Krylov solver (global)'
     else
-      write(iout_,*) '  Krylov solver (local) '
+      write(iout_,*) trim(prefix_), '  Krylov solver (local) '
     end if
-    write(iout_,*) '    method: ',sv%method
+    write(iout_,*) trim(prefix_), '    method: ',sv%method
-    write(iout_,*) '     kprec: ',sv%kprec
+    write(iout_,*) trim(prefix_), '     kprec: ',sv%kprec
-    if (sv%i_sub_solve > 0) then
+    call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
-      write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
+    write(iout_,*) trim(prefix_), '     itmax: ',sv%itmax
-    else
+    write(iout_,*) trim(prefix_), '       eps: ',sv%eps
-      write(iout_,*) ' sub_solve: ',sv%sub_solve
-    end if
-    write(iout_,*) '     itmax: ',sv%itmax
-    write(iout_,*) '       eps: ',sv%eps
-    write(iout_,*) '    fillin: ',sv%fillin
-
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_c_mumps_solver.F90

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

amgprec/amg_c_onelev_mod.f90

@@ -189,6 +189,7 @@ module amg_c_onelev_mod
     procedure, pass(lv) :: descr   => amg_c_base_onelev_descr
     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
@@ -257,7 +258,7 @@ module amg_c_onelev_mod
   end interface
 
   interface
-    subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
+    subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
       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
@@ -268,6 +269,7 @@ module amg_c_onelev_mod
       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
     end subroutine amg_c_base_onelev_descr
   end interface
 
@@ -284,7 +286,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, &
@@ -296,6 +298,18 @@ interface
     end subroutine amg_c_base_onelev_free
   end interface
 
+  interface
+    subroutine amg_c_base_onelev_free_smoothers(lv,info)
+      import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
+           & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
+           & psb_ipk_, psb_epk_, psb_desc_type
+      implicit none
+
+      class(amg_c_onelev_type), intent(inout) :: lv
+      integer(psb_ipk_), intent(out)                :: info
+    end subroutine amg_c_base_onelev_free_smoothers
+  end interface
+
   interface
     subroutine amg_c_base_onelev_check(lv,info)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &

amgprec/amg_c_prec_type.f90

@@ -135,7 +135,9 @@ 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
   end type amg_cprec_type
 
@@ -155,15 +157,16 @@ module amg_c_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity)
+    subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity,prefix)
       import :: amg_cprec_type, psb_ipk_
       implicit none
       ! Arguments
-      class(amg_cprec_type), intent(in)      :: prec
+      class(amg_cprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out) :: info
+      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
     end subroutine amg_cfile_prec_descr
   end interface
 
@@ -344,6 +347,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
@@ -617,6 +628,68 @@ contains
 
   end subroutine amg_c_prec_free
 
+  subroutine amg_c_smoothers_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_cprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_c_smoothers_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    if (allocated(prec%precv)) then
+      do i=1,size(prec%precv)
+        call prec%precv(i)%free_smoothers(info)
+      end do
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_c_smoothers_free
+
+  subroutine amg_c_hierarchy_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_cprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_c_hierarchy_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    me=-1
+    write(0,*) 'Missing implementation '
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_c_hierarchy_free
 
 
   !

amgprec/amg_c_slu_solver.F90

@@ -385,20 +385,22 @@ contains
   
   end subroutine c_slu_solver_finalize
 
-  subroutine c_slu_solver_descr(sv,info,iout,coarse)
+  subroutine c_slu_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_c_slu_solver_type), intent(in) :: sv
-    integer, intent(out)                     :: info
+    integer, intent(out)                       :: info
-    integer, intent(in), optional            :: iout
+    integer, intent(in), optional              :: iout
-    logical, intent(in), optional       :: coarse
+    logical, intent(in), optional              :: coarse
+    character(len=*), intent(in), optional     :: prefix
 
     ! Local variables
     integer      :: err_act
     character(len=20), parameter :: name='amg_c_slu_solver_descr'
     integer :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -407,8 +409,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
     
-    write(iout_,*) '  SuperLU Sparse Factorization Solver. '
+    write(iout_,*) trim(prefix_), '  SuperLU Sparse Factorization Solver. '
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_c_symdec_aggregator_mod.f90

@@ -88,16 +88,25 @@ contains
     val = "Symmetric Decoupled aggregation"
   end function amg_c_symdec_aggregator_fmt
   
-  subroutine  amg_c_symdec_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_c_symdec_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none 
     class(amg_c_symdec_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
 
-    write(iout,*) 'Decoupled Aggregator locally-symmetrized'
+    character(1024)    :: prefix_
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+
-    call parms%mldescr(iout,info)
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
+    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info,prefix=prefix)
     
     return
   end subroutine amg_c_symdec_aggregator_descr

amgprec/amg_d_ainv_solver.F90

@@ -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), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_d_ainv_solver_clone_settings
+  end interface
 
   interface
     subroutine amg_d_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
@@ -198,7 +209,7 @@ module amg_d_ainv_solver
 !!$  end interface
 
   interface
-    subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse)
+    subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
 
       Implicit None
@@ -208,7 +219,7 @@ module amg_d_ainv_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-
+      character(len=*), intent(in), optional  :: prefix
     end subroutine amg_d_ainv_solver_descr
   end interface
 

amgprec/amg_d_as_smoother.f90

@@ -396,21 +396,23 @@ contains
   end subroutine d_as_smoother_default
 
 
-  subroutine d_as_smoother_descr(sm,info,iout,coarse)
+  subroutine d_as_smoother_descr(sm,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_d_as_smoother_type), intent(in) :: sm
-    integer(psb_ipk_), intent(out)                      :: info
+    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional             :: iout
+    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional             :: coarse
+    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_as_smoother_descr'
     integer(psb_ipk_) :: iout_
     logical      :: coarse_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -424,16 +426,21 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (.not.coarse_) then 
-      write(iout_,*) '  Additive Schwarz with  ',&
+      write(iout_,*) trim(prefix_), '  Additive Schwarz with  ',&
            &  sm%novr, ' overlap layers.'
-      write(iout_,*) '  Restrictor:  ',restrict_names(sm%restr)
+      write(iout_,*) trim(prefix_), '  Restrictor:  ',restrict_names(sm%restr)
-      write(iout_,*) '  Prolongator: ',prolong_names(sm%prol)
+      write(iout_,*) trim(prefix_), '  Prolongator: ',prolong_names(sm%prol)
-      write(iout_,*) '  Local solver:'
+      write(iout_,*) trim(prefix_), '  Local solver:'
     endif
     if (allocated(sm%sv)) then 
-      call sm%sv%descr(info,iout_,coarse=coarse)
+      call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
     end if
 
     call psb_erractionrestore(err_act)

amgprec/amg_d_base_aggregator_mod.f90

@@ -275,15 +275,22 @@ contains
     val = .false.
   end function amg_d_base_aggregator_xt_desc
 
-  subroutine  amg_d_base_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_d_base_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none 
     class(amg_d_base_aggregator_type), intent(in) :: ag
     type(amg_dml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
+    character(1024)    :: prefix_
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info)
+    call parms%mldescr(iout,info,prefix=prefix)
     
     return
   end subroutine amg_d_base_aggregator_descr

amgprec/amg_d_base_smoother_mod.f90

@@ -272,7 +272,7 @@ module amg_d_base_smoother_mod
   end interface
   
   interface 
-    subroutine amg_d_base_smoother_descr(sm,info,iout,coarse)
+    subroutine amg_d_base_smoother_descr(sm,info,iout,coarse,prefix)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
            & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
            & amg_d_base_smoother_type, psb_ipk_
@@ -281,6 +281,7 @@ module amg_d_base_smoother_mod
       integer(psb_ipk_), intent(out)                :: info
       integer(psb_ipk_), intent(in), optional       :: iout
       logical, intent(in), optional                 :: coarse
+      character(len=*), intent(in), optional        :: prefix
     end subroutine amg_d_base_smoother_descr
   end interface
   

amgprec/amg_d_base_solver_mod.f90

@@ -270,7 +270,7 @@ module amg_d_base_solver_mod
   end interface
   
   interface
-    subroutine amg_d_base_solver_descr(sv,info,iout,coarse)
+    subroutine amg_d_base_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
            & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
            & amg_d_base_solver_type, psb_ipk_
@@ -281,7 +281,7 @@ module amg_d_base_solver_mod
       integer(psb_ipk_), intent(out)              :: info
       integer(psb_ipk_), intent(in), optional     :: iout
       logical, intent(in), optional               :: coarse
-
+      character(len=*), intent(in), optional      :: prefix
     end subroutine amg_d_base_solver_descr
   end interface 
   

amgprec/amg_d_dec_aggregator_mod.f90

@@ -184,16 +184,23 @@ contains
     val = "Decoupled aggregation"
   end function amg_d_dec_aggregator_fmt
   
-  subroutine  amg_d_dec_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_d_dec_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none 
     class(amg_d_dec_aggregator_type), intent(in) :: ag
     type(amg_dml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
+    character(1024)    :: prefix_
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout,*) 'Decoupled Aggregator'
+    write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info)
+    call parms%mldescr(iout,info,prefix=prefix)
     
     return
   end subroutine amg_d_dec_aggregator_descr

amgprec/amg_d_diag_solver.f90

@@ -219,7 +219,7 @@ contains
 
   end subroutine d_diag_solver_free
 
-  subroutine d_diag_solver_descr(sv,info,iout,coarse)
+  subroutine d_diag_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -228,11 +228,13 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
+    character(len=*), intent(in), optional      :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_d_diag_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -240,8 +242,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    
+    if (present(prefix)) then
-    write(iout_,*) '  Diagonal local solver '
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout_,*) trim(prefix_), '  Diagonal local solver '
 
     return
 
@@ -352,7 +359,7 @@ module amg_d_l1_diag_solver
   
 contains
 
-  subroutine d_l1_diag_solver_descr(sv,info,iout,coarse)
+  subroutine d_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -361,11 +368,13 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
+    character(len=*), intent(in), optional  :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_d_l1_diag_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -373,8 +382,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    
+    if (present(prefix)) then
-    write(iout_,*) '  L1 Diagonal solver '
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout_,*) trim(prefix_), '  L1 Diagonal solver '
 
     return
 

amgprec/amg_d_gs_solver.f90

@@ -433,20 +433,22 @@ contains
     return
   end subroutine d_gs_solver_free
 
-  subroutine d_gs_solver_descr(sv,info,iout,coarse)
+  subroutine d_gs_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_d_gs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional    :: iout
+    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional       :: coarse
+    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_gs_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -455,12 +457,17 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     
@@ -526,20 +533,22 @@ contains
     val = .true.
   end function d_gs_solver_is_iterative
     
-  subroutine d_bwgs_solver_descr(sv,info,iout,coarse)
+  subroutine d_bwgs_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_d_bwgs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional    :: iout
+    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional       :: coarse
+    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_bwgs_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -548,12 +557,17 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     

amgprec/amg_d_id_solver.f90

@@ -157,7 +157,7 @@ contains
     return
   end subroutine d_id_solver_free
 
-  subroutine d_id_solver_descr(sv,info,iout,coarse)
+  subroutine d_id_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -165,12 +165,14 @@ contains
     class(amg_d_id_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)            :: info
     integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional       :: coarse
+    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_id_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -178,8 +180,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
     
-    write(iout_,*) '  Identity local solver '
+    write(iout_,*) trim(prefix_), '  Identity local solver '
 
     return
 

amgprec/amg_d_ilu_solver.f90

@@ -406,7 +406,7 @@ contains
     return
   end subroutine d_ilu_solver_free
 
-  subroutine d_ilu_solver_descr(sv,info,iout,coarse)
+  subroutine d_ilu_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -414,12 +414,14 @@ contains
     class(amg_d_ilu_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional       :: coarse
+    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_ilu_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -428,15 +430,20 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout_,*) '  Incomplete factorization solver: ',&
+    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_)      
-      write(iout_,*) '  Fill level:',sv%fill_in
+      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
     case(psb_ilu_t_)         
-      write(iout_,*) '  Fill level:',sv%fill_in
+      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-      write(iout_,*) '  Fill threshold :',sv%thresh
+      write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
     end select
 
     call psb_erractionrestore(err_act)

amgprec/amg_d_invk_solver.f90

@@ -52,6 +52,7 @@ module amg_d_invk_solver
   contains
     procedure, pass(sv) :: check   => amg_d_invk_solver_check
     procedure, pass(sv) :: clone   => amg_d_invk_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_d_invk_solver_clone_settings
     procedure, pass(sv) :: build   => amg_d_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_d_invk_solver_cseti
     procedure, pass(sv) :: descr   => amg_d_invk_solver_descr
@@ -73,6 +74,17 @@ module amg_d_invk_solver
     end subroutine amg_d_invk_solver_clone
   end interface
 
+  interface
+    subroutine amg_d_invk_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
+       & amg_d_base_solver_type, psb_dpk_, amg_d_invk_solver_type, psb_ipk_
+      Implicit None
+      class(amg_d_invk_solver_type), intent(inout)              :: sv
+      class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_d_invk_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_d_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
@@ -123,7 +135,7 @@ module amg_d_invk_solver
   end interface
 
   interface
-    subroutine amg_d_invk_solver_descr(sv,info,iout,coarse)
+    subroutine amg_d_invk_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_dpk_, amg_d_invk_solver_type, psb_ipk_
 
       Implicit None
@@ -133,7 +145,7 @@ module amg_d_invk_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-
+      character(len=*), intent(in), optional  :: prefix
     end subroutine amg_d_invk_solver_descr
   end interface
 

amgprec/amg_d_invt_solver.f90

@@ -52,6 +52,7 @@ module amg_d_invt_solver
   contains
     procedure, pass(sv) :: check   => amg_d_invt_solver_check
     procedure, pass(sv) :: clone   => amg_d_invt_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_d_invt_solver_clone_settings
     procedure, pass(sv) :: build   => amg_d_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_d_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_d_invt_solver_csetr
@@ -73,6 +74,17 @@ module amg_d_invt_solver
     end subroutine amg_d_invt_solver_clone
   end interface
 
+  interface
+    subroutine amg_d_invt_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
+       & amg_d_base_solver_type, psb_dpk_, amg_d_invt_solver_type, psb_ipk_
+      Implicit None
+      class(amg_d_invt_solver_type), intent(inout)              :: sv
+      class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_d_invt_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_d_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
@@ -134,16 +146,17 @@ module amg_d_invt_solver
   end interface
 
   interface
-    subroutine amg_d_invt_solver_descr(sv,info,iout,coarse)
+    subroutine amg_d_invt_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_dpk_, amg_d_invt_solver_type, psb_ipk_
 
       Implicit None
 
       ! Arguments
       class(amg_d_invt_solver_type), intent(in) :: sv
-      integer(psb_ipk_), intent(out)            :: info
+      integer(psb_ipk_), intent(out)              :: info
-      integer(psb_ipk_), intent(in), optional   :: iout
+      integer(psb_ipk_), intent(in), optional     :: iout
-      logical, intent(in), optional             :: coarse
+      logical, intent(in), optional               :: coarse
+      character(len=*), intent(in), optional      :: prefix
 
     end subroutine amg_d_invt_solver_descr
   end interface

amgprec/amg_d_jac_smoother.f90

@@ -219,12 +219,13 @@ module amg_d_jac_smoother
   end interface
 
   interface
-    subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse)
+    subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse,prefix)
       import :: amg_d_jac_smoother_type, psb_ipk_
       class(amg_d_jac_smoother_type), intent(in) :: sm
       integer(psb_ipk_), intent(out)               :: info
       integer(psb_ipk_), intent(in), optional      :: iout
-      logical, intent(in), optional              :: coarse
+      logical, intent(in), optional                :: coarse
+      character(len=*), intent(in), optional       :: prefix
     end subroutine amg_d_jac_smoother_descr
   end interface
 
@@ -313,12 +314,13 @@ module amg_d_jac_smoother
   end interface
 
   interface
-    subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse)
+    subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
       import :: amg_d_l1_jac_smoother_type, psb_ipk_
       class(amg_d_l1_jac_smoother_type), intent(in) :: sm
-      integer(psb_ipk_), intent(out)               :: info
+      integer(psb_ipk_), intent(out)                  :: info
-      integer(psb_ipk_), intent(in), optional      :: iout
+      integer(psb_ipk_), intent(in), optional         :: iout
-      logical, intent(in), optional              :: coarse
+      logical, intent(in), optional                   :: coarse
+      character(len=*), intent(in), optional          :: prefix
     end subroutine amg_d_l1_jac_smoother_descr
   end interface
 

amgprec/amg_d_jac_solver.f90

@@ -0,0 +1,582 @@
+!  
+!   
+!                             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()
+    call sv%dv%free(info)
+    if (allocated(sv%d)) deallocate(sv%d)
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine d_jac_solver_free
+
+  subroutine d_jac_solver_descr(sv,info,iout,coarse,prefix)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_d_jac_solver_type), intent(in) :: sv
+    integer(psb_ipk_), intent(out)            :: info
+    integer(psb_ipk_), intent(in), optional   :: iout
+    logical, intent(in), optional             :: coarse
+    character(len=*), intent(in), optional    :: prefix
+
+    ! Local variables
+    integer(psb_ipk_)      :: err_act
+    character(len=20), parameter :: name='amg_d_jac_solver_descr'
+    integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+    if (present(iout)) then 
+      iout_ = iout 
+    else
+      iout_ = psb_out_unit
+    endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    if (sv%eps<=dzero) then 
+      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  ',&
+           &  sv%sweeps,' sweeps'
+    else
+      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  tolerance',&
+           &  sv%eps,' and maxit', sv%sweeps
+    end if
+    
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine d_jac_solver_descr
+
+  function d_jac_solver_get_nzeros(sv) result(val)
+
+    implicit none 
+    ! Arguments
+    class(amg_d_jac_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+    integer(psb_ipk_)        :: i
+    
+    val = 0 
+    val = val + sv%a%get_nzeros()
+    val = val + sv%dv%get_nrows()
+
+    return
+  end function d_jac_solver_get_nzeros
+
+  function d_jac_solver_sizeof(sv) result(val)
+
+    implicit none 
+    ! Arguments
+    class(amg_d_jac_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+    integer(psb_ipk_)        :: i
+
+    val = psb_sizeof_ip 
+    val = val + sv%a%sizeof()
+    val = val + sv%dv%sizeof()
+
+    return
+  end function d_jac_solver_sizeof
+
+  function d_jac_solver_get_fmt() result(val)
+    implicit none 
+    character(len=32)  :: val
+
+    val = "Jacobi solver"
+  end function d_jac_solver_get_fmt
+
+  function d_jac_solver_get_id() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = amg_jac_
+  end function d_jac_solver_get_id
+
+  !
+  ! If this is true, then the solver needs a starting
+  ! guess. Currently only handled in JAC smoother. 
+  ! 
+  function d_jac_solver_is_iterative() result(val)
+    implicit none 
+    logical  :: val
+
+    val = .true.
+  end function d_jac_solver_is_iterative
+    
+  function d_jac_solver_get_wrksize() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = 2
+  end function d_jac_solver_get_wrksize
+
+  subroutine d_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_d_l1_jac_solver_type), intent(in) :: sv
+    integer(psb_ipk_), intent(out)            :: info
+    integer(psb_ipk_), intent(in), optional   :: iout
+    logical, intent(in), optional             :: coarse
+    character(len=*), intent(in), optional    :: prefix
+
+    ! Local variables
+    integer(psb_ipk_)      :: err_act
+    character(len=20), parameter :: name='amg_d_l1_jac_solver_descr'
+    integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+    if (present(iout)) then 
+      iout_ = iout 
+    else
+      iout_ = psb_out_unit
+    endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    if (sv%eps<=dzero) then 
+      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  ',&
+           &  sv%sweeps,' sweeps'
+    else
+      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  tolerance',&
+           &  sv%eps,' and maxit', sv%sweeps
+    end if
+    
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine d_l1_jac_solver_descr
+
+  function d_l1_jac_solver_get_fmt() result(val)
+    implicit none 
+    character(len=32)  :: val
+
+    val = "L1-Jacobi solver"
+  end function d_l1_jac_solver_get_fmt
+
+  function d_l1_jac_solver_get_id() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = amg_l1_jac_
+  end function d_l1_jac_solver_get_id
+  
+end module amg_d_jac_solver

amgprec/amg_d_krm_solver.f90

@@ -436,7 +436,7 @@ contains
     val = "KRM solver"
   end function d_krm_solver_get_fmt
 
-  subroutine d_krm_solver_descr(sv,info,iout,coarse)
+  subroutine d_krm_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -444,12 +444,14 @@ contains
     class(amg_d_krm_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional       :: coarse
+    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_krm_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -458,23 +460,22 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (sv%global) then
-      write(iout_,*) '  Krylov solver (global)'
+      write(iout_,*) trim(prefix_), '  Krylov solver (global)'
     else
-      write(iout_,*) '  Krylov solver (local) '
+      write(iout_,*) trim(prefix_), '  Krylov solver (local) '
     end if
-    write(iout_,*) '    method: ',sv%method
+    write(iout_,*) trim(prefix_), '    method: ',sv%method
-    write(iout_,*) '     kprec: ',sv%kprec
+    write(iout_,*) trim(prefix_), '     kprec: ',sv%kprec
-    if (sv%i_sub_solve > 0) then
+    call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
-      write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
+    write(iout_,*) trim(prefix_), '     itmax: ',sv%itmax
-    else
+    write(iout_,*) trim(prefix_), '       eps: ',sv%eps
-      write(iout_,*) ' sub_solve: ',sv%sub_solve
-    end if
-    write(iout_,*) '     itmax: ',sv%itmax
-    write(iout_,*) '       eps: ',sv%eps
-    write(iout_,*) '    fillin: ',sv%fillin
-
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_d_matchboxp_mod.f90

@@ -68,7 +68,7 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-module dmatchboxp_mod
+module amg_d_matchboxp_mod
 
   use iso_c_binding
   use psb_base_cbind_mod
@@ -94,34 +94,25 @@ module dmatchboxp_mod
     end subroutine dMatchBoxPC
   end interface MatchBoxPC
 
-  interface i_aggr_assign
+  interface amg_i_aggr_assign
-    module procedure i_daggr_assign
+    module procedure amg_i_d_aggr_assign
-  end interface i_aggr_assign
+  end interface amg_i_aggr_assign
 
-  interface build_matching
+  interface amg_par_build_matching
-    module procedure dbuild_matching
+    module procedure amg_d_par_build_matching
-  end interface build_matching
+  end interface amg_par_build_matching
 
-  interface build_ahat
+  interface amg_par_build_ahat
-    module procedure dbuild_ahat
+    module procedure amg_d_par_build_ahat
-  end interface build_ahat
+  end interface amg_par_build_ahat
 
-  interface psb_gtranspose
+  interface amg_PMatchBox
-    module procedure psb_dgtranspose
+    module procedure amg_d_PMatchBox
-  end interface psb_gtranspose
+  end interface amg_PMatchBox
 
-  interface psb_htranspose
-    module procedure psb_dhtranspose
-  end interface psb_htranspose
-
-  interface PMatchBox
-    module procedure dPMatchBox
-  end interface PMatchBox
-
-  logical, parameter, private :: print_statistics=.false.
 contains
 
-  subroutine dmatchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
+  subroutine amg_d_matchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
        & symmetrize,reproducible,display_inp, display_out, print_out)
     use psb_base_mod
     use psb_util_mod
@@ -152,9 +143,10 @@ contains
     type(psb_ld_coo_sparse_mat) :: tmpcoo
     logical  :: display_out_, print_out_, reproducible_
     logical, parameter  :: dump=.false., debug=.false., dump_mate=.false., &
-         & debug_ilaggr=.false., debug_sync=.false.
+         & debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
     integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
     logical, parameter :: do_timings=.true.
+    integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
 
     ictxt = desc_a%get_ctxt()
     call psb_info(ictxt,iam,np)
@@ -196,7 +188,7 @@ contains
     call desc_a%l2gip(ilv,info,owned=.false.)
 
     call psb_geall(ilaggr,desc_a,info)
-    ilaggr = -1
+    ilaggr = ilaggr_neginit
     call psb_geasb(ilaggr,desc_a,info)
     nr = a%get_nrows()
     nc = a%get_ncols()
@@ -214,7 +206,7 @@ contains
     end if
     if (do_timings) call psb_toc(idx_phase1)
     if (do_timings) call psb_tic(idx_bldmtc)
-    call build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
+    call amg_par_build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
     if (do_timings) call psb_toc(idx_bldmtc)
     if (debug) write(0,*) iam,' buildprol from buildmatching:',&
          & info
@@ -222,7 +214,20 @@ contains
       call psb_barrier(ictxt)
       if (iam == 0) write(0,*)' out from buildmatching:', info
     end if
-
+    if (debug_mate) then
+      block
+        integer(psb_lpk_), allocatable :: ckmate(:)
+        allocate(ckmate(nr))
+        ckmate(1:nr) = mate(1:nr)
+        call psb_msort(ckmate(1:nr))
+        do i=1,nr-1
+          if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
+            write(0,*) iam,' Duplicate mate entry  at',i,' :',ckmate(i)
+          end if
+        end do
+      end block
+    end if
+     
     if (info == 0) then
       if (do_timings) call psb_tic(idx_phase2)
       if (debug_sync) then
@@ -268,7 +273,7 @@ contains
           cycle
         else
 
-          if (ilaggr(k) == -1) then
+          if (ilaggr(k) == ilaggr_neginit) then
 
             wk   = w(k)
             widx = w(idx)
@@ -276,7 +281,7 @@ contains
             nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
             if (nrmagg > epsilon(nrmagg)) then
               if (idx <= nr) then
-                if (ilaggr(idx) == -1) then
+                if (ilaggr(idx) == ilaggr_neginit) then
                   ! Now, if both vertices are local, the aggregate is local
                   ! (kinda obvious).
                   nlaggr(iam) = nlaggr(iam) + 1
@@ -284,6 +289,9 @@ contains
                   ilaggr(idx) = nlaggr(iam)
                   wtemp(k)    = w(k)/nrmagg
                   wtemp(idx)  = w(idx)/nrmagg
+                else
+                  write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
+                       &mate(idx),ilaggr(idx)
                 end if
                 nlpairs = nlpairs+1
               else if (idx <= nc) then
@@ -303,7 +311,7 @@ contains
                     ilaggr(k)   = nlaggr(iam)
                     nlpairs = nlpairs+1
                   else
-                    ilaggr(k) = -2
+                    ilaggr(k) = ilaggr_nonlocal
                   end if
                 else
                   ! Use a statistically unbiased tie-breaking rule,
@@ -312,13 +320,13 @@ contains
                   ! Should be a symmetric function.
                   !
                   call desc_a%indxmap%qry_halo_owner(idx,iown,info)
-                  ip    = i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
+                  ip    = amg_i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
                   if (iam == ip) then
                     nlaggr(iam) = nlaggr(iam) + 1
                     ilaggr(k)   = nlaggr(iam)
                     nlpairs = nlpairs+1
                   else
-                    ilaggr(k) = -2
+                    ilaggr(k) = ilaggr_nonlocal
                   end if
                 end if
               end if
@@ -334,6 +342,12 @@ contains
                 nlsingl     = nlsingl + 1
               end if
             end if
+            if (ilaggr(k) == ilaggr_neginit) then
+              write(0,*) iam,' Error: no update to ',k,mate(k),&
+                   & abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
+            end if
+          else
+            if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
           end if
         end if
       end do
@@ -341,7 +355,7 @@ contains
       if (do_timings) call psb_tic(idx_phase3)
 
       ! Ok, now compute offsets, gather halo and fix non-local
-      ! aggregates  (those where ilaggr == -2)
+      ! aggregates  (those where ilaggr == ilaggr_nonlocal)
       call psb_sum(ictxt,nlaggr)
       ntaggr  = sum(nlaggr(0:np-1))
       naggrm1 = sum(nlaggr(0:iam-1))
@@ -356,7 +370,7 @@ contains
       call psb_halo(wtemp,desc_a,info)
       ! Cleanup as yet unmarked entries
       do k=1,nr
-        if (ilaggr(k) == -2) then
+        if (ilaggr(k) == ilaggr_nonlocal) then
           idx = mate(k)
           if (idx > nr) then
             i   = ilaggr(idx)
@@ -368,9 +382,14 @@ contains
           else
             write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
           end if
-        end if
+        else if (ilaggr(k) <0) then
-        if (ilaggr(k) <0) then
+          write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
-          write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
+          write(0,*) iam,'         :             : ',nr,nc,mate(k)
+          if (mate(k) <= nr) then
+            write(0,*) iam,'         :             : ',ilaggr(mate(k)),mate(mate(k)),&
+                 & ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
+          end if
+          flush(0)
         end if
       end do
       if (debug_sync) then
@@ -422,13 +441,11 @@ contains
         nlpairs    = v(3)
 
       end block
-      if (print_statistics) then
+      if (iam == 0) then
-        if (iam == 0) then
+        write(0,*) iam,'Matching statistics: Unmatched nodes ',&
-          write(0,*) 'Matching statistics: Unmatched nodes ',&
+             & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
-               & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
-        end if
       end if
-      
+
       if (display_out_) then
         block
           integer(psb_ipk_) :: idx
@@ -516,9 +533,9 @@ contains
       write(0,*) iam,' :  error from Matching: ',info
     end if
 
-  end subroutine dmatchboxp_build_prol
+  end subroutine amg_d_matchboxp_build_prol
 
-  function i_daggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
+  function amg_i_d_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
        & result(iproc)
     !
     ! How to break ties? This
@@ -560,10 +577,10 @@ contains
         iproc = iown
       end if
     end if
-  end function i_daggr_assign
+  end function amg_i_d_aggr_assign
 
 
-  subroutine dbuild_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
+  subroutine amg_d_par_build_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
     use psb_base_mod
     use psb_util_mod
     use iso_c_binding
@@ -612,7 +629,7 @@ contains
       if (iam == 0) write(0,*)' Into build_ahat:'
     end if
     if (do_timings) call psb_tic(idx_bldahat)
-    call build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
+    call amg_par_build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
     if (do_timings) call psb_toc(idx_bldahat)
     if (info /= 0) then
       write(0,*) 'Error from build_ahat ', info
@@ -703,7 +720,7 @@ contains
       !
       if (debug) write(0,*) iam,' buildmatching into PMatchBox:'
       if (do_timings) call psb_tic(idx_cmboxp)
-      call PMatchBox(nr,nz,vlptr,vlind,ewght,&
+      call amg_PMatchBox(nr,nz,vlptr,vlind,ewght,&
            & vnl, mate, iam, np,ictxt,&
            & msgis,msgas,msgprc,ph0t,ph1t,ph2t,ph1crd,ph2crd,info,display_inp)
       if (do_timings) call psb_toc(idx_cmboxp)
@@ -767,9 +784,9 @@ contains
       val(1:n) = tmp(1:n)
     end subroutine fix_order
 
-  end subroutine dbuild_matching
+  end subroutine amg_d_par_build_matching
 
-  subroutine dbuild_ahat(w,a,ahat,desc_a,info,symmetrize)
+  subroutine amg_d_par_build_ahat(w,a,ahat,desc_a,info,symmetrize)
     use psb_base_mod
     implicit none
     real(psb_dpk_), intent(in)           :: w(:)
@@ -1005,301 +1022,9 @@ contains
       end block
     end if
 
-  end subroutine dbuild_ahat
+  end subroutine amg_d_par_build_ahat
 
-  subroutine psb_dgtranspose(ain,aout,desc_a,info)
+  subroutine amg_d_PMatchBox(nlver,nledge,verlocptr,verlocind,edgelocweight,&
-    use psb_base_mod
-    implicit none
-    type(psb_ldspmat_type), intent(in)  :: ain
-    type(psb_ldspmat_type), intent(out) :: aout
-    type(psb_desc_type)           :: desc_a
-    integer(psb_ipk_), intent(out) :: info
-
-    !
-    ! BEWARE: This routine works under the assumption
-    ! that the same DESC_A works for both A and A^T, which
-    ! essentially means that A has a symmetric pattern.
-    !
-    type(psb_ldspmat_type) :: atmp, ahalo, aglb
-    type(psb_ld_coo_sparse_mat) :: tmpcoo
-    type(psb_ld_csr_sparse_mat) :: tmpcsr
-    type(psb_ctxt_type) :: ictxt
-    integer(psb_ipk_) :: me, np
-    integer(psb_lpk_) :: i, j, k, nrow, ncol
-    integer(psb_lpk_), allocatable :: ilv(:)
-    character(len=80) :: aname
-    logical, parameter :: debug=.false., dump=.false., debug_sync=.false.
-
-    ictxt = desc_a%get_context()
-    call psb_info(ictxt,me,np)
-
-    nrow = desc_a%get_local_rows()
-    ncol = desc_a%get_local_cols()
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'Start gtranspose '
-    end if
-    call ain%cscnv(tmpcsr,info)
-
-    if (debug) then
-      ilv = [(i,i=1,ncol)]
-      call desc_a%l2gip(ilv,info,owned=.false.)
-      write(aname,'(a,i3.3,a)') 'atmp-preh-',me,'.mtx'
-      call ain%print(fname=aname,head='atmp before haloTest ',iv=ilv)
-    end if
-    if (dump) then
-      call ain%cscnv(atmp,info)
-      call psb_gather(aglb,atmp,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'aglob-prehalo.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-    !call psb_loc_to_glob(tmpcsr%ja,desc_a,info)
-    call atmp%mv_from(tmpcsr)
-
-    if (debug) then
-      write(aname,'(a,i3.3,a)') 'tmpcsr-',me,'.mtx'
-      call atmp%print(fname=aname,head='tmpcsr ',iv=ilv)
-      !call psb_set_debug_level(9999)
-    end if
-
-    ! FIXME THIS NEEDS REWORKING
-    if (debug) write(0,*) me,' Gtranspose into sphalo :',atmp%get_nrows(),atmp%get_ncols()
-    call psb_sphalo(atmp,desc_a,ahalo,info,rowscale=.true.)
-    if (debug) write(0,*) me,' Gtranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols()
-    if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
-
-    if (debug) then
-      write(aname,'(a,i3.3,a)') 'ahalo-',me,'.mtx'
-      call ahalo%print(fname=aname,head='ahalo after haloTest ',iv=ilv)
-      write(aname,'(a,i3.3,a)') 'atmp-h-',me,'.mtx'
-      call atmp%print(fname=aname,head='atmp after haloTest ',iv=ilv)
-    end if
-
-    if (info == psb_success_) call ahalo%free()
-
-    call atmp%cp_to(tmpcoo)
-    call tmpcoo%transp()
-    !call psb_glob_to_loc(tmpcoo%ia,desc_a,info,iact='I')
-    if (debug) write(0,*) 'Before cleanup:',tmpcoo%get_nzeros()
-
-    j = 0
-    do k=1, tmpcoo%get_nzeros()
-      if ((tmpcoo%ia(k) > 0).and.(tmpcoo%ja(k)>0)) then
-        j = j+1
-        tmpcoo%ia(j)  = tmpcoo%ia(k)
-        tmpcoo%ja(j)  = tmpcoo%ja(k)
-        tmpcoo%val(j) = tmpcoo%val(k)
-      end if
-    end do
-    call tmpcoo%set_nzeros(j)
-
-    if (debug) write(0,*) 'After cleanup:',tmpcoo%get_nzeros()
-
-    call ahalo%mv_from(tmpcoo)
-    if (dump) then
-      call psb_gather(aglb,ahalo,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'atran-preclip.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-
-    call ahalo%csclip(aout,info,imax=nrow)
-
-    if (debug) write(0,*) 'After clip:',aout%get_nzeros()
-
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'End gtranspose '
-    end if
-    !call aout%cscnv(info,type='csr')
-
-    if (dump) then
-      write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx'
-      call aout%print(fname=aname,head='atrans ',iv=ilv)
-      call psb_gather(aglb,aout,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'atran.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-  end subroutine psb_dgtranspose
-
-  subroutine psb_dhtranspose(ain,aout,desc_a,info)
-    use psb_base_mod
-    implicit none
-    type(psb_ldspmat_type), intent(in)  :: ain
-    type(psb_ldspmat_type), intent(out) :: aout
-    type(psb_desc_type)           :: desc_a
-    integer(psb_ipk_), intent(out) :: info
-
-    !
-    ! BEWARE: This routine works under the assumption
-    ! that the same DESC_A works for both A and A^T, which
-    ! essentially means that A has a symmetric pattern.
-    !
-    type(psb_ldspmat_type) :: atmp, ahalo, aglb
-    type(psb_ld_coo_sparse_mat) :: tmpcoo, tmpc1, tmpc2, tmpch
-    type(psb_ld_csr_sparse_mat) :: tmpcsr
-    integer(psb_ipk_) :: nz1, nz2, nzh, nz
-    type(psb_ctxt_type) :: ictxt
-    integer(psb_ipk_) :: me, np
-    integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz
-    integer(psb_lpk_), allocatable :: ilv(:)
-    character(len=80) :: aname
-    logical, parameter :: debug=.false., dump=.false., debug_sync=.false.
-
-    ictxt = desc_a%get_context()
-    call psb_info(ictxt,me,np)
-
-    nrow = desc_a%get_local_rows()
-    ncol = desc_a%get_local_cols()
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'Start htranspose '
-    end if
-    call ain%cscnv(tmpcsr,info)
-
-    if (debug) then
-      ilv = [(i,i=1,ncol)]
-      call desc_a%l2gip(ilv,info,owned=.false.)
-      write(aname,'(a,i3.3,a)') 'atmp-preh-',me,'.mtx'
-      call ain%print(fname=aname,head='atmp before haloTest ',iv=ilv)
-    end if
-    if (dump) then
-      call ain%cscnv(atmp,info)
-      call psb_gather(aglb,atmp,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'aglob-prehalo.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-    !call psb_loc_to_glob(tmpcsr%ja,desc_a,info)
-    call atmp%mv_from(tmpcsr)
-
-    if (debug) then
-      write(aname,'(a,i3.3,a)') 'tmpcsr-',me,'.mtx'
-      call atmp%print(fname=aname,head='tmpcsr ',iv=ilv)
-      !call psb_set_debug_level(9999)
-    end if
-
-    ! FIXME THIS NEEDS REWORKING
-    if (debug) write(0,*) me,' Htranspose into sphalo :',atmp%get_nrows(),atmp%get_ncols()
-    if (.true.) then
-      call psb_sphalo(atmp,desc_a,ahalo,info, outfmt='coo  ')
-      call atmp%mv_to(tmpc1)
-      call ahalo%mv_to(tmpch)
-      nz1 = tmpc1%get_nzeros()
-      call psb_loc_to_glob(tmpc1%ia(1:nz1),desc_a,info,iact='I')
-      call psb_loc_to_glob(tmpc1%ja(1:nz1),desc_a,info,iact='I')
-      nzh = tmpch%get_nzeros()
-      call psb_loc_to_glob(tmpch%ia(1:nzh),desc_a,info,iact='I')
-      call psb_loc_to_glob(tmpch%ja(1:nzh),desc_a,info,iact='I')
-      nlz = nz1+nzh
-      call tmpcoo%allocate(ncol,ncol,nlz)
-      tmpcoo%ia(1:nz1) = tmpc1%ia(1:nz1)
-      tmpcoo%ja(1:nz1) = tmpc1%ja(1:nz1)
-      tmpcoo%val(1:nz1) = tmpc1%val(1:nz1)
-      tmpcoo%ia(nz1+1:nz1+nzh) = tmpch%ia(1:nzh)
-      tmpcoo%ja(nz1+1:nz1+nzh) = tmpch%ja(1:nzh)
-      tmpcoo%val(nz1+1:nz1+nzh) = tmpch%val(1:nzh)
-      call tmpcoo%set_nzeros(nlz)
-      call tmpcoo%transp()
-      nz = tmpcoo%get_nzeros()
-      call psb_glob_to_loc(tmpcoo%ia(1:nz),desc_a,info,iact='I')
-      call psb_glob_to_loc(tmpcoo%ja(1:nz),desc_a,info,iact='I')
-      if (.true.) then
-        call tmpcoo%clean_negidx(info)
-      else
-        j = 0
-        do k=1, tmpcoo%get_nzeros()
-          if ((tmpcoo%ia(k) > 0).and.(tmpcoo%ja(k)>0)) then
-            j = j+1
-            tmpcoo%ia(j)  = tmpcoo%ia(k)
-            tmpcoo%ja(j)  = tmpcoo%ja(k)
-            tmpcoo%val(j) = tmpcoo%val(k)
-          end if
-        end do
-        call tmpcoo%set_nzeros(j)
-      end if
-      call ahalo%mv_from(tmpcoo)
-      call ahalo%csclip(aout,info,imax=nrow)
-
-    else
-      call psb_sphalo(atmp,desc_a,ahalo,info, rowscale=.true.)
-      if (debug) write(0,*) me,' Htranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols()
-      if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
-
-      if (debug) then
-        write(aname,'(a,i3.3,a)') 'ahalo-',me,'.mtx'
-        call ahalo%print(fname=aname,head='ahalo after haloTest ',iv=ilv)
-        write(aname,'(a,i3.3,a)') 'atmp-h-',me,'.mtx'
-        call atmp%print(fname=aname,head='atmp after haloTest ',iv=ilv)
-      end if
-
-      if (info == psb_success_) call ahalo%free()
-
-      call atmp%cp_to(tmpcoo)
-      call tmpcoo%transp()
-      if (debug) write(0,*) 'Before cleanup:',tmpcoo%get_nzeros()
-      if (.true.) then
-        call tmpcoo%clean_negidx(info)
-      else
-
-        j = 0
-        do k=1, tmpcoo%get_nzeros()
-          if ((tmpcoo%ia(k) > 0).and.(tmpcoo%ja(k)>0)) then
-            j = j+1
-            tmpcoo%ia(j)  = tmpcoo%ia(k)
-            tmpcoo%ja(j)  = tmpcoo%ja(k)
-            tmpcoo%val(j) = tmpcoo%val(k)
-          end if
-        end do
-        call tmpcoo%set_nzeros(j)
-      end if
-
-      if (debug) write(0,*) 'After cleanup:',tmpcoo%get_nzeros()
-
-      call ahalo%mv_from(tmpcoo)
-      if (dump) then
-        call psb_gather(aglb,ahalo,desc_a,info)
-        if (me==psb_root_) then
-          write(aname,'(a,i3.3,a)') 'atran-preclip.mtx'
-          call aglb%print(fname=aname,head='Test ')
-        end if
-      end if
-
-
-      call ahalo%csclip(aout,info,imax=nrow)
-    end if
-
-    if (debug) write(0,*) 'After clip:',aout%get_nzeros()
-
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'End htranspose '
-    end if
-    !call aout%cscnv(info,type='csr')
-
-    if (dump) then
-      write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx'
-      call aout%print(fname=aname,head='atrans ',iv=ilv)
-      call psb_gather(aglb,aout,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'atran.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-  end subroutine psb_dhtranspose
-
-  subroutine dPMatchBox(nlver,nledge,verlocptr,verlocind,edgelocweight,&
        & verdistance, mate, myrank, numprocs, ictxt,&
        & msgindsent,msgactualsent,msgpercent,&
        & ph0_time, ph1_time, ph2_time, ph1_card, ph2_card,info,display_inp)
@@ -1434,6 +1159,6 @@ contains
     end if
     where(mate>=0) mate = mate + 1
 
-  end subroutine dPMatchBox
+  end subroutine amg_d_PMatchBox
 
-end module dmatchboxp_mod
+end module amg_d_matchboxp_mod

amgprec/amg_d_mumps_solver.F90

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

amgprec/amg_d_onelev_mod.f90

@@ -190,6 +190,7 @@ module amg_d_onelev_mod
     procedure, pass(lv) :: descr   => amg_d_base_onelev_descr
     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
@@ -258,7 +259,7 @@ module amg_d_onelev_mod
   end interface
 
   interface
-    subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
+    subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
       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
@@ -269,6 +270,7 @@ module amg_d_onelev_mod
       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
     end subroutine amg_d_base_onelev_descr
   end interface
 
@@ -285,7 +287,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, &
@@ -297,6 +299,18 @@ interface
     end subroutine amg_d_base_onelev_free
   end interface
 
+  interface
+    subroutine amg_d_base_onelev_free_smoothers(lv,info)
+      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
+           & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
+           & psb_ipk_, psb_epk_, psb_desc_type
+      implicit none
+
+      class(amg_d_onelev_type), intent(inout) :: lv
+      integer(psb_ipk_), intent(out)                :: info
+    end subroutine amg_d_base_onelev_free_smoothers
+  end interface
+
   interface
     subroutine amg_d_base_onelev_check(lv,info)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &

amgprec/amg_d_parmatch_aggregator_mod.F90

@@ -118,7 +118,7 @@
 
 module amg_d_parmatch_aggregator_mod
   use amg_d_base_aggregator_mod
-  use dmatchboxp_mod
+  use amg_d_matchboxp_mod
 #if defined(SERIAL_MPI)
   type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
   end type amg_d_parmatch_aggregator_type
@@ -132,8 +132,6 @@ module amg_d_parmatch_aggregator_mod
     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
-    integer(psb_ipk_) :: max_csize
-    integer(psb_ipk_) :: max_nlevels
     logical           :: reproducible_matching = .false.
     logical           :: need_symmetrize       = .false.
     logical           :: unsmoothed_hierarchy  = .true.
@@ -143,18 +141,18 @@ module amg_d_parmatch_aggregator_mod
     procedure, pass(ag) :: mat_asb      => amg_d_parmatch_aggregator_mat_asb
     procedure, pass(ag) :: inner_mat_asb      => amg_d_parmatch_aggregator_inner_mat_asb
     procedure, pass(ag) :: bld_map      => amg_d_parmatch_aggregator_bld_map
-    procedure, pass(ag) :: csetc        => d_parmatch_aggr_csetc
+    procedure, pass(ag) :: csetc        => amg_d_parmatch_aggr_csetc
-    procedure, pass(ag) :: cseti        => d_parmatch_aggr_cseti
+    procedure, pass(ag) :: cseti        => amg_d_parmatch_aggr_cseti
-    procedure, pass(ag) :: default      => d_parmatch_aggr_set_default
+    procedure, pass(ag) :: default      => amg_d_parmatch_aggr_set_default
-    procedure, pass(ag) :: sizeof       => d_parmatch_aggregator_sizeof
+    procedure, pass(ag) :: sizeof       => amg_d_parmatch_aggregator_sizeof
-    procedure, pass(ag) :: update_next  => d_parmatch_aggregator_update_next
+    procedure, pass(ag) :: update_next  => amg_d_parmatch_aggregator_update_next
-    procedure, pass(ag) :: bld_wnxt     => d_parmatch_bld_wnxt
+    procedure, pass(ag) :: bld_wnxt     => amg_d_parmatch_bld_wnxt
-    procedure, pass(ag) :: bld_default_w    => d_bld_default_w
+    procedure, pass(ag) :: bld_default_w    => amg_d_bld_default_w
-    procedure, pass(ag) :: set_c_default_w  => d_set_prm_c_default_w
+    procedure, pass(ag) :: set_c_default_w  => amg_d_set_prm_c_default_w
-    procedure, pass(ag) :: descr        => d_parmatch_aggregator_descr
+    procedure, pass(ag) :: descr        => amg_d_parmatch_aggregator_descr
-    procedure, pass(ag) :: clone        => d_parmatch_aggregator_clone
+    procedure, pass(ag) :: clone        => amg_d_parmatch_aggregator_clone
-    procedure, pass(ag) :: free         => d_parmatch_aggregator_free
+    procedure, pass(ag) :: free         => amg_d_parmatch_aggregator_free
-    procedure, nopass   :: fmt          => d_parmatch_aggregator_fmt
+    procedure, nopass   :: fmt          => amg_d_parmatch_aggregator_fmt
     procedure, nopass   :: xt_desc      => amg_d_parmatch_aggregator_xt_desc
   end type amg_d_parmatch_aggregator_type
 
@@ -320,7 +318,7 @@ module amg_d_parmatch_aggregator_mod
 
 contains
 
-  subroutine d_bld_default_w(ag,nr)
+  subroutine amg_d_bld_default_w(ag,nr)
     use psb_realloc_mod
     implicit none
     class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -330,9 +328,9 @@ contains
     if (info /= psb_success_) return
     ag%w = done
     !call ag%set_c_default_w()
-  end subroutine d_bld_default_w
+  end subroutine amg_d_bld_default_w
 
-  subroutine d_set_prm_c_default_w(ag)
+  subroutine amg_d_set_prm_c_default_w(ag)
     use psb_realloc_mod
     use iso_c_binding
     implicit none
@@ -342,9 +340,9 @@ contains
     !write(0,*) 'prm_c_deafult_w '
     call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
 
-  end subroutine d_set_prm_c_default_w
+  end subroutine amg_d_set_prm_c_default_w
 
-  subroutine d_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
+  subroutine amg_d_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
     use psb_realloc_mod
     implicit none
     class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -358,14 +356,14 @@ contains
     !write(0,*) 'Executing bld_wnxt ',nx
     call psb_realloc(nx,ag%w_nxt,info)
 
-  end subroutine d_parmatch_bld_wnxt
+  end subroutine amg_d_parmatch_bld_wnxt
 
-  function d_parmatch_aggregator_fmt() result(val)
+  function amg_d_parmatch_aggregator_fmt() result(val)
     implicit none
     character(len=32)  :: val
 
     val = "Parallel Matching aggregation"
-  end function d_parmatch_aggregator_fmt
+  end function amg_d_parmatch_aggregator_fmt
 
   function amg_d_parmatch_aggregator_xt_desc() result(val)
     implicit none
@@ -374,7 +372,7 @@ contains
     val = .true.
   end function amg_d_parmatch_aggregator_xt_desc
 
-  function d_parmatch_aggregator_sizeof(ag) result(val)
+  function amg_d_parmatch_aggregator_sizeof(ag) result(val)
     use psb_realloc_mod
     implicit none
     class(amg_d_parmatch_aggregator_type), intent(in)  :: ag
@@ -390,23 +388,30 @@ contains
     if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
     if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
 
-  end function d_parmatch_aggregator_sizeof
+  end function amg_d_parmatch_aggregator_sizeof
 
-  subroutine  d_parmatch_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_d_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none
     class(amg_d_parmatch_aggregator_type), intent(in) :: ag
     type(amg_dml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
+    character(1024)    :: prefix_
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout,*) 'Parallel Matching Aggregator'
+    write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
-    write(iout,*) '   Number of matching  sweeps: ',ag%n_sweeps
+    write(iout,*) trim(prefix_),' ','   Number of matching  sweeps: ',ag%n_sweeps
-    write(iout,*) '   Matching algorithm         : MatchBoxP (PREIS)'
+    write(iout,*) trim(prefix_),' ','   Matching algorithm         : MatchBoxP (PREIS)'
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info)
+    call parms%mldescr(iout,info,prefix=prefix)
 
     return
-  end subroutine d_parmatch_aggregator_descr
+  end subroutine amg_d_parmatch_aggregator_descr
 
   function is_legal_malg(alg) result(val)
     logical :: val
@@ -437,7 +442,7 @@ contains
   end function is_legal_nlevels
 
 
-  subroutine  d_parmatch_aggregator_update_next(ag,agnext,info)
+  subroutine  amg_d_parmatch_aggregator_update_next(ag,agnext,info)
     use psb_realloc_mod
     implicit none
     class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -452,10 +457,10 @@ contains
            & 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))&
+!!$      if (.not.is_legal_csize(agnext%max_csize))&
-           & agnext%max_csize    = ag%max_csize
+!!$           & agnext%max_csize    = ag%max_csize
-      if (.not.is_legal_nlevels(agnext%max_nlevels))&
+!!$      if (.not.is_legal_nlevels(agnext%max_nlevels))&
-           & agnext%max_nlevels  = ag%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)
@@ -470,9 +475,9 @@ contains
       ! What should we do here?
     end select
     info = 0
-  end subroutine d_parmatch_aggregator_update_next
+  end subroutine amg_d_parmatch_aggregator_update_next
 
-  subroutine d_parmatch_aggr_csetc(ag,what,val,info,idx)
+  subroutine amg_d_parmatch_aggr_csetc(ag,what,val,info,idx)
 
     Implicit None
 
@@ -514,9 +519,9 @@ contains
       ! Do nothing
     end select
     return
-  end subroutine d_parmatch_aggr_csetc
+  end subroutine amg_d_parmatch_aggr_csetc
 
-  subroutine d_parmatch_aggr_cseti(ag,what,val,info,idx)
+  subroutine amg_d_parmatch_aggr_cseti(ag,what,val,info,idx)
 
     Implicit None
 
@@ -540,10 +545,6 @@ contains
     case('AGGR_SIZE')
       ag%orig_aggr_size = val
       ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
-    case('PRMC_MAX_CSIZE')
-      ag%max_csize=val
-    case('PRMC_MAX_NLEVELS')
-      ag%max_nlevels=val
     case('PRMC_W_SIZE')
       call ag%bld_default_w(val)
     case('PRMC_REPRODUCIBLE_MATCHING')
@@ -556,9 +557,9 @@ contains
       ! Do nothing
     end select
     return
-  end subroutine d_parmatch_aggr_cseti
+  end subroutine amg_d_parmatch_aggr_cseti
 
-  subroutine d_parmatch_aggr_set_default(ag)
+  subroutine amg_d_parmatch_aggr_set_default(ag)
 
     Implicit None
 
@@ -569,8 +570,8 @@ contains
     ag%matching_alg  = 0
     ag%n_sweeps      = 1
     ag%jacobi_sweeps = 0
-    ag%max_nlevels   = 36
+!!$    ag%max_nlevels   = 36
-    ag%max_csize     = -1
+!!$    ag%max_csize     = -1
     !
     ! Apparently BootCMatch works better
     ! by keeping all entries
@@ -579,9 +580,9 @@ contains
 
     return
 
-  end subroutine d_parmatch_aggr_set_default
+  end subroutine amg_d_parmatch_aggr_set_default
 
-  subroutine  d_parmatch_aggregator_free(ag,info)
+  subroutine  amg_d_parmatch_aggregator_free(ag,info)
     use iso_c_binding
     implicit none
     class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
@@ -618,9 +619,9 @@ contains
       call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
     end if
 
-  end subroutine d_parmatch_aggregator_free
+  end subroutine amg_d_parmatch_aggregator_free
 
-  subroutine  d_parmatch_aggregator_clone(ag,agnext,info)
+  subroutine  amg_d_parmatch_aggregator_clone(ag,agnext,info)
     implicit none
     class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
     class(amg_d_base_aggregator_type), allocatable, intent(inout) :: agnext
@@ -640,7 +641,7 @@ contains
       ! Should never ever get here
       info = -1
     end select
-  end subroutine d_parmatch_aggregator_clone
+  end subroutine amg_d_parmatch_aggregator_clone
 
   subroutine  amg_d_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
        & op_restr,op_prol,map,info)

amgprec/amg_d_prec_type.f90

@@ -135,7 +135,9 @@ 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
   end type amg_dprec_type
 
@@ -155,15 +157,16 @@ module amg_d_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity)
+    subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity,prefix)
       import :: amg_dprec_type, psb_ipk_
       implicit none
       ! Arguments
-      class(amg_dprec_type), intent(in)      :: prec
+      class(amg_dprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out) :: info
+      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
     end subroutine amg_dfile_prec_descr
   end interface
 
@@ -344,6 +347,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
@@ -617,6 +628,68 @@ contains
 
   end subroutine amg_d_prec_free
 
+  subroutine amg_d_smoothers_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_dprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_d_smoothers_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    if (allocated(prec%precv)) then
+      do i=1,size(prec%precv)
+        call prec%precv(i)%free_smoothers(info)
+      end do
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_d_smoothers_free
+
+  subroutine amg_d_hierarchy_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_dprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_d_hierarchy_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    me=-1
+    write(0,*) 'Missing implementation '
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_d_hierarchy_free
 
 
   !

amgprec/amg_d_slu_solver.F90

@@ -385,20 +385,22 @@ contains
   
   end subroutine d_slu_solver_finalize
 
-  subroutine d_slu_solver_descr(sv,info,iout,coarse)
+  subroutine d_slu_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_d_slu_solver_type), intent(in) :: sv
-    integer, intent(out)                     :: info
+    integer, intent(out)                       :: info
-    integer, intent(in), optional            :: iout
+    integer, intent(in), optional              :: iout
-    logical, intent(in), optional       :: coarse
+    logical, intent(in), optional              :: coarse
+    character(len=*), intent(in), optional     :: prefix
 
     ! Local variables
     integer      :: err_act
     character(len=20), parameter :: name='amg_d_slu_solver_descr'
     integer :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -407,8 +409,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
     
-    write(iout_,*) '  SuperLU Sparse Factorization Solver. '
+    write(iout_,*) trim(prefix_), '  SuperLU Sparse Factorization Solver. '
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_d_sludist_solver.F90

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

amgprec/amg_d_symdec_aggregator_mod.f90

@@ -88,16 +88,25 @@ contains
     val = "Symmetric Decoupled aggregation"
   end function amg_d_symdec_aggregator_fmt
   
-  subroutine  amg_d_symdec_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_d_symdec_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none 
     class(amg_d_symdec_aggregator_type), intent(in) :: ag
     type(amg_dml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
 
-    write(iout,*) 'Decoupled Aggregator locally-symmetrized'
+    character(1024)    :: prefix_
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+
-    call parms%mldescr(iout,info)
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
+    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info,prefix=prefix)
     
     return
   end subroutine amg_d_symdec_aggregator_descr

amgprec/amg_d_umf_solver.F90

@@ -390,20 +390,22 @@ contains
   
   end subroutine d_umf_solver_finalize
 
-  subroutine d_umf_solver_descr(sv,info,iout,coarse)
+  subroutine d_umf_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_d_umf_solver_type), intent(in) :: sv
-    integer, intent(out)                     :: info
+    integer, intent(out)                       :: info
-    integer, intent(in), optional            :: iout
+    integer, intent(in), optional              :: iout
-    logical, intent(in), optional       :: coarse
+    logical, intent(in), optional              :: coarse
+      character(len=*), intent(in), optional   :: prefix
 
     ! Local variables
     integer      :: err_act
     character(len=20), parameter :: name='amg_d_umf_solver_descr'
     integer :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -412,8 +414,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
     
-    write(iout_,*) '  UMFPACK Sparse Factorization Solver. '
+    write(iout_,*) trim(prefix_), '  UMFPACK Sparse Factorization Solver. '
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_s_ainv_solver.F90

@@ -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), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_s_ainv_solver_clone_settings
+  end interface
 
   interface
     subroutine amg_s_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
@@ -198,7 +209,7 @@ module amg_s_ainv_solver
 !!$  end interface
 
   interface
-    subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse)
+    subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
 
       Implicit None
@@ -208,7 +219,7 @@ module amg_s_ainv_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-
+      character(len=*), intent(in), optional  :: prefix
     end subroutine amg_s_ainv_solver_descr
   end interface
 

amgprec/amg_s_as_smoother.f90

@@ -396,21 +396,23 @@ contains
   end subroutine s_as_smoother_default
 
 
-  subroutine s_as_smoother_descr(sm,info,iout,coarse)
+  subroutine s_as_smoother_descr(sm,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_s_as_smoother_type), intent(in) :: sm
-    integer(psb_ipk_), intent(out)                      :: info
+    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional             :: iout
+    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional             :: coarse
+    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_as_smoother_descr'
     integer(psb_ipk_) :: iout_
     logical      :: coarse_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -424,16 +426,21 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (.not.coarse_) then 
-      write(iout_,*) '  Additive Schwarz with  ',&
+      write(iout_,*) trim(prefix_), '  Additive Schwarz with  ',&
            &  sm%novr, ' overlap layers.'
-      write(iout_,*) '  Restrictor:  ',restrict_names(sm%restr)
+      write(iout_,*) trim(prefix_), '  Restrictor:  ',restrict_names(sm%restr)
-      write(iout_,*) '  Prolongator: ',prolong_names(sm%prol)
+      write(iout_,*) trim(prefix_), '  Prolongator: ',prolong_names(sm%prol)
-      write(iout_,*) '  Local solver:'
+      write(iout_,*) trim(prefix_), '  Local solver:'
     endif
     if (allocated(sm%sv)) then 
-      call sm%sv%descr(info,iout_,coarse=coarse)
+      call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
     end if
 
     call psb_erractionrestore(err_act)

amgprec/amg_s_base_aggregator_mod.f90

@@ -275,15 +275,22 @@ contains
     val = .false.
   end function amg_s_base_aggregator_xt_desc
 
-  subroutine  amg_s_base_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_s_base_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none 
     class(amg_s_base_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
+    character(1024)    :: prefix_
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info)
+    call parms%mldescr(iout,info,prefix=prefix)
     
     return
   end subroutine amg_s_base_aggregator_descr

amgprec/amg_s_base_smoother_mod.f90

@@ -272,7 +272,7 @@ module amg_s_base_smoother_mod
   end interface
   
   interface 
-    subroutine amg_s_base_smoother_descr(sm,info,iout,coarse)
+    subroutine amg_s_base_smoother_descr(sm,info,iout,coarse,prefix)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
            & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
            & amg_s_base_smoother_type, psb_ipk_
@@ -281,6 +281,7 @@ module amg_s_base_smoother_mod
       integer(psb_ipk_), intent(out)                :: info
       integer(psb_ipk_), intent(in), optional       :: iout
       logical, intent(in), optional                 :: coarse
+      character(len=*), intent(in), optional        :: prefix
     end subroutine amg_s_base_smoother_descr
   end interface
   

amgprec/amg_s_base_solver_mod.f90

@@ -270,7 +270,7 @@ module amg_s_base_solver_mod
   end interface
   
   interface
-    subroutine amg_s_base_solver_descr(sv,info,iout,coarse)
+    subroutine amg_s_base_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
            & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
            & amg_s_base_solver_type, psb_ipk_
@@ -281,7 +281,7 @@ module amg_s_base_solver_mod
       integer(psb_ipk_), intent(out)              :: info
       integer(psb_ipk_), intent(in), optional     :: iout
       logical, intent(in), optional               :: coarse
-
+      character(len=*), intent(in), optional      :: prefix
     end subroutine amg_s_base_solver_descr
   end interface 
   

amgprec/amg_s_dec_aggregator_mod.f90

@@ -184,16 +184,23 @@ contains
     val = "Decoupled aggregation"
   end function amg_s_dec_aggregator_fmt
   
-  subroutine  amg_s_dec_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_s_dec_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none 
     class(amg_s_dec_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
+    character(1024)    :: prefix_
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout,*) 'Decoupled Aggregator'
+    write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info)
+    call parms%mldescr(iout,info,prefix=prefix)
     
     return
   end subroutine amg_s_dec_aggregator_descr

amgprec/amg_s_diag_solver.f90

@@ -219,7 +219,7 @@ contains
 
   end subroutine s_diag_solver_free
 
-  subroutine s_diag_solver_descr(sv,info,iout,coarse)
+  subroutine s_diag_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -228,11 +228,13 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
+    character(len=*), intent(in), optional      :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_s_diag_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -240,8 +242,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    
+    if (present(prefix)) then
-    write(iout_,*) '  Diagonal local solver '
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout_,*) trim(prefix_), '  Diagonal local solver '
 
     return
 
@@ -352,7 +359,7 @@ module amg_s_l1_diag_solver
   
 contains
 
-  subroutine s_l1_diag_solver_descr(sv,info,iout,coarse)
+  subroutine s_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -361,11 +368,13 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
+    character(len=*), intent(in), optional  :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_s_l1_diag_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -373,8 +382,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    
+    if (present(prefix)) then
-    write(iout_,*) '  L1 Diagonal solver '
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout_,*) trim(prefix_), '  L1 Diagonal solver '
 
     return
 

amgprec/amg_s_gs_solver.f90

@@ -433,20 +433,22 @@ contains
     return
   end subroutine s_gs_solver_free
 
-  subroutine s_gs_solver_descr(sv,info,iout,coarse)
+  subroutine s_gs_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_s_gs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional    :: iout
+    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional       :: coarse
+    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_gs_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -455,12 +457,17 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     
@@ -526,20 +533,22 @@ contains
     val = .true.
   end function s_gs_solver_is_iterative
     
-  subroutine s_bwgs_solver_descr(sv,info,iout,coarse)
+  subroutine s_bwgs_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_s_bwgs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional    :: iout
+    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional       :: coarse
+    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_bwgs_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -548,12 +557,17 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     

amgprec/amg_s_id_solver.f90

@@ -157,7 +157,7 @@ contains
     return
   end subroutine s_id_solver_free
 
-  subroutine s_id_solver_descr(sv,info,iout,coarse)
+  subroutine s_id_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -165,12 +165,14 @@ contains
     class(amg_s_id_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)            :: info
     integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional       :: coarse
+    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_id_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -178,8 +180,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
     
-    write(iout_,*) '  Identity local solver '
+    write(iout_,*) trim(prefix_), '  Identity local solver '
 
     return
 

amgprec/amg_s_ilu_solver.f90

@@ -406,7 +406,7 @@ contains
     return
   end subroutine s_ilu_solver_free
 
-  subroutine s_ilu_solver_descr(sv,info,iout,coarse)
+  subroutine s_ilu_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -414,12 +414,14 @@ contains
     class(amg_s_ilu_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional       :: coarse
+    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_ilu_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -428,15 +430,20 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout_,*) '  Incomplete factorization solver: ',&
+    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_)      
-      write(iout_,*) '  Fill level:',sv%fill_in
+      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
     case(psb_ilu_t_)         
-      write(iout_,*) '  Fill level:',sv%fill_in
+      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-      write(iout_,*) '  Fill threshold :',sv%thresh
+      write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
     end select
 
     call psb_erractionrestore(err_act)

amgprec/amg_s_invk_solver.f90

@@ -52,6 +52,7 @@ module amg_s_invk_solver
   contains
     procedure, pass(sv) :: check   => amg_s_invk_solver_check
     procedure, pass(sv) :: clone   => amg_s_invk_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_s_invk_solver_clone_settings
     procedure, pass(sv) :: build   => amg_s_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_s_invk_solver_cseti
     procedure, pass(sv) :: descr   => amg_s_invk_solver_descr
@@ -73,6 +74,17 @@ module amg_s_invk_solver
     end subroutine amg_s_invk_solver_clone
   end interface
 
+  interface
+    subroutine amg_s_invk_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
+       & amg_s_base_solver_type, psb_spk_, amg_s_invk_solver_type, psb_ipk_
+      Implicit None
+      class(amg_s_invk_solver_type), intent(inout)              :: sv
+      class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_s_invk_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_s_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
@@ -123,7 +135,7 @@ module amg_s_invk_solver
   end interface
 
   interface
-    subroutine amg_s_invk_solver_descr(sv,info,iout,coarse)
+    subroutine amg_s_invk_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_spk_, amg_s_invk_solver_type, psb_ipk_
 
       Implicit None
@@ -133,7 +145,7 @@ module amg_s_invk_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-
+      character(len=*), intent(in), optional  :: prefix
     end subroutine amg_s_invk_solver_descr
   end interface
 

amgprec/amg_s_invt_solver.f90

@@ -52,6 +52,7 @@ module amg_s_invt_solver
   contains
     procedure, pass(sv) :: check   => amg_s_invt_solver_check
     procedure, pass(sv) :: clone   => amg_s_invt_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_s_invt_solver_clone_settings
     procedure, pass(sv) :: build   => amg_s_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_s_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_s_invt_solver_csetr
@@ -73,6 +74,17 @@ module amg_s_invt_solver
     end subroutine amg_s_invt_solver_clone
   end interface
 
+  interface
+    subroutine amg_s_invt_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
+       & amg_s_base_solver_type, psb_spk_, amg_s_invt_solver_type, psb_ipk_
+      Implicit None
+      class(amg_s_invt_solver_type), intent(inout)              :: sv
+      class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_s_invt_solver_clone_settings
+  end interface
+
   interface
     subroutine amg_s_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
@@ -134,16 +146,17 @@ module amg_s_invt_solver
   end interface
 
   interface
-    subroutine amg_s_invt_solver_descr(sv,info,iout,coarse)
+    subroutine amg_s_invt_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_spk_, amg_s_invt_solver_type, psb_ipk_
 
       Implicit None
 
       ! Arguments
       class(amg_s_invt_solver_type), intent(in) :: sv
-      integer(psb_ipk_), intent(out)            :: info
+      integer(psb_ipk_), intent(out)              :: info
-      integer(psb_ipk_), intent(in), optional   :: iout
+      integer(psb_ipk_), intent(in), optional     :: iout
-      logical, intent(in), optional             :: coarse
+      logical, intent(in), optional               :: coarse
+      character(len=*), intent(in), optional      :: prefix
 
     end subroutine amg_s_invt_solver_descr
   end interface

amgprec/amg_s_jac_smoother.f90

@@ -219,12 +219,13 @@ module amg_s_jac_smoother
   end interface
 
   interface
-    subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse)
+    subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse,prefix)
       import :: amg_s_jac_smoother_type, psb_ipk_
       class(amg_s_jac_smoother_type), intent(in) :: sm
       integer(psb_ipk_), intent(out)               :: info
       integer(psb_ipk_), intent(in), optional      :: iout
-      logical, intent(in), optional              :: coarse
+      logical, intent(in), optional                :: coarse
+      character(len=*), intent(in), optional       :: prefix
     end subroutine amg_s_jac_smoother_descr
   end interface
 
@@ -313,12 +314,13 @@ module amg_s_jac_smoother
   end interface
 
   interface
-    subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse)
+    subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
       import :: amg_s_l1_jac_smoother_type, psb_ipk_
       class(amg_s_l1_jac_smoother_type), intent(in) :: sm
-      integer(psb_ipk_), intent(out)               :: info
+      integer(psb_ipk_), intent(out)                  :: info
-      integer(psb_ipk_), intent(in), optional      :: iout
+      integer(psb_ipk_), intent(in), optional         :: iout
-      logical, intent(in), optional              :: coarse
+      logical, intent(in), optional                   :: coarse
+      character(len=*), intent(in), optional          :: prefix
     end subroutine amg_s_l1_jac_smoother_descr
   end interface
 

amgprec/amg_s_jac_solver.f90

@@ -0,0 +1,582 @@
+!  
+!   
+!                             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()
+    call sv%dv%free(info)
+    if (allocated(sv%d)) deallocate(sv%d)
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine s_jac_solver_free
+
+  subroutine s_jac_solver_descr(sv,info,iout,coarse,prefix)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_s_jac_solver_type), intent(in) :: sv
+    integer(psb_ipk_), intent(out)            :: info
+    integer(psb_ipk_), intent(in), optional   :: iout
+    logical, intent(in), optional             :: coarse
+    character(len=*), intent(in), optional    :: prefix
+
+    ! Local variables
+    integer(psb_ipk_)      :: err_act
+    character(len=20), parameter :: name='amg_s_jac_solver_descr'
+    integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+    if (present(iout)) then 
+      iout_ = iout 
+    else
+      iout_ = psb_out_unit
+    endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    if (sv%eps<=dzero) then 
+      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  ',&
+           &  sv%sweeps,' sweeps'
+    else
+      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  tolerance',&
+           &  sv%eps,' and maxit', sv%sweeps
+    end if
+    
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine s_jac_solver_descr
+
+  function s_jac_solver_get_nzeros(sv) result(val)
+
+    implicit none 
+    ! Arguments
+    class(amg_s_jac_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+    integer(psb_ipk_)        :: i
+    
+    val = 0 
+    val = val + sv%a%get_nzeros()
+    val = val + sv%dv%get_nrows()
+
+    return
+  end function s_jac_solver_get_nzeros
+
+  function s_jac_solver_sizeof(sv) result(val)
+
+    implicit none 
+    ! Arguments
+    class(amg_s_jac_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+    integer(psb_ipk_)        :: i
+
+    val = psb_sizeof_ip 
+    val = val + sv%a%sizeof()
+    val = val + sv%dv%sizeof()
+
+    return
+  end function s_jac_solver_sizeof
+
+  function s_jac_solver_get_fmt() result(val)
+    implicit none 
+    character(len=32)  :: val
+
+    val = "Jacobi solver"
+  end function s_jac_solver_get_fmt
+
+  function s_jac_solver_get_id() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = amg_jac_
+  end function s_jac_solver_get_id
+
+  !
+  ! If this is true, then the solver needs a starting
+  ! guess. Currently only handled in JAC smoother. 
+  ! 
+  function s_jac_solver_is_iterative() result(val)
+    implicit none 
+    logical  :: val
+
+    val = .true.
+  end function s_jac_solver_is_iterative
+    
+  function s_jac_solver_get_wrksize() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = 2
+  end function s_jac_solver_get_wrksize
+
+  subroutine s_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_s_l1_jac_solver_type), intent(in) :: sv
+    integer(psb_ipk_), intent(out)            :: info
+    integer(psb_ipk_), intent(in), optional   :: iout
+    logical, intent(in), optional             :: coarse
+    character(len=*), intent(in), optional    :: prefix
+
+    ! Local variables
+    integer(psb_ipk_)      :: err_act
+    character(len=20), parameter :: name='amg_s_l1_jac_solver_descr'
+    integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+    if (present(iout)) then 
+      iout_ = iout 
+    else
+      iout_ = psb_out_unit
+    endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    if (sv%eps<=dzero) then 
+      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  ',&
+           &  sv%sweeps,' sweeps'
+    else
+      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  tolerance',&
+           &  sv%eps,' and maxit', sv%sweeps
+    end if
+    
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine s_l1_jac_solver_descr
+
+  function s_l1_jac_solver_get_fmt() result(val)
+    implicit none 
+    character(len=32)  :: val
+
+    val = "L1-Jacobi solver"
+  end function s_l1_jac_solver_get_fmt
+
+  function s_l1_jac_solver_get_id() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = amg_l1_jac_
+  end function s_l1_jac_solver_get_id
+  
+end module amg_s_jac_solver

amgprec/amg_s_krm_solver.f90

@@ -436,7 +436,7 @@ contains
     val = "KRM solver"
   end function s_krm_solver_get_fmt
 
-  subroutine s_krm_solver_descr(sv,info,iout,coarse)
+  subroutine s_krm_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -444,12 +444,14 @@ contains
     class(amg_s_krm_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional       :: coarse
+    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_krm_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -458,23 +460,22 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (sv%global) then
-      write(iout_,*) '  Krylov solver (global)'
+      write(iout_,*) trim(prefix_), '  Krylov solver (global)'
     else
-      write(iout_,*) '  Krylov solver (local) '
+      write(iout_,*) trim(prefix_), '  Krylov solver (local) '
     end if
-    write(iout_,*) '    method: ',sv%method
+    write(iout_,*) trim(prefix_), '    method: ',sv%method
-    write(iout_,*) '     kprec: ',sv%kprec
+    write(iout_,*) trim(prefix_), '     kprec: ',sv%kprec
-    if (sv%i_sub_solve > 0) then
+    call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
-      write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
+    write(iout_,*) trim(prefix_), '     itmax: ',sv%itmax
-    else
+    write(iout_,*) trim(prefix_), '       eps: ',sv%eps
-      write(iout_,*) ' sub_solve: ',sv%sub_solve
-    end if
-    write(iout_,*) '     itmax: ',sv%itmax
-    write(iout_,*) '       eps: ',sv%eps
-    write(iout_,*) '    fillin: ',sv%fillin
-
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_s_matchboxp_mod.f90

@@ -68,7 +68,7 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-module smatchboxp_mod
+module amg_s_matchboxp_mod
 
   use iso_c_binding
   use psb_base_cbind_mod
@@ -94,34 +94,25 @@ module smatchboxp_mod
     end subroutine sMatchBoxPC
   end interface MatchBoxPC
 
-  interface i_aggr_assign
+  interface amg_i_aggr_assign
-    module procedure i_saggr_assign
+    module procedure amg_i_s_aggr_assign
-  end interface i_aggr_assign
+  end interface amg_i_aggr_assign
 
-  interface build_matching
+  interface amg_par_build_matching
-    module procedure sbuild_matching
+    module procedure amg_s_par_build_matching
-  end interface build_matching
+  end interface amg_par_build_matching
 
-  interface build_ahat
+  interface amg_par_build_ahat
-    module procedure sbuild_ahat
+    module procedure amg_s_par_build_ahat
-  end interface build_ahat
+  end interface amg_par_build_ahat
 
-  interface psb_gtranspose
+  interface amg_PMatchBox
-    module procedure psb_sgtranspose
+    module procedure amg_s_PMatchBox
-  end interface psb_gtranspose
+  end interface amg_PMatchBox
 
-  interface psb_htranspose
-    module procedure psb_shtranspose
-  end interface psb_htranspose
-
-  interface PMatchBox
-    module procedure sPMatchBox
-  end interface PMatchBox
-
-  logical, parameter, private :: print_statistics=.false.
 contains
 
-  subroutine smatchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
+  subroutine amg_s_matchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
        & symmetrize,reproducible,display_inp, display_out, print_out)
     use psb_base_mod
     use psb_util_mod
@@ -152,9 +143,10 @@ contains
     type(psb_ls_coo_sparse_mat) :: tmpcoo
     logical  :: display_out_, print_out_, reproducible_
     logical, parameter  :: dump=.false., debug=.false., dump_mate=.false., &
-         & debug_ilaggr=.false., debug_sync=.false.
+         & debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
     integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
     logical, parameter :: do_timings=.true.
+    integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
 
     ictxt = desc_a%get_ctxt()
     call psb_info(ictxt,iam,np)
@@ -196,7 +188,7 @@ contains
     call desc_a%l2gip(ilv,info,owned=.false.)
 
     call psb_geall(ilaggr,desc_a,info)
-    ilaggr = -1
+    ilaggr = ilaggr_neginit
     call psb_geasb(ilaggr,desc_a,info)
     nr = a%get_nrows()
     nc = a%get_ncols()
@@ -214,7 +206,7 @@ contains
     end if
     if (do_timings) call psb_toc(idx_phase1)
     if (do_timings) call psb_tic(idx_bldmtc)
-    call build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
+    call amg_par_build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
     if (do_timings) call psb_toc(idx_bldmtc)
     if (debug) write(0,*) iam,' buildprol from buildmatching:',&
          & info
@@ -222,7 +214,20 @@ contains
       call psb_barrier(ictxt)
       if (iam == 0) write(0,*)' out from buildmatching:', info
     end if
-
+    if (debug_mate) then
+      block
+        integer(psb_lpk_), allocatable :: ckmate(:)
+        allocate(ckmate(nr))
+        ckmate(1:nr) = mate(1:nr)
+        call psb_msort(ckmate(1:nr))
+        do i=1,nr-1
+          if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
+            write(0,*) iam,' Duplicate mate entry  at',i,' :',ckmate(i)
+          end if
+        end do
+      end block
+    end if
+     
     if (info == 0) then
       if (do_timings) call psb_tic(idx_phase2)
       if (debug_sync) then
@@ -268,7 +273,7 @@ contains
           cycle
         else
 
-          if (ilaggr(k) == -1) then
+          if (ilaggr(k) == ilaggr_neginit) then
 
             wk   = w(k)
             widx = w(idx)
@@ -276,7 +281,7 @@ contains
             nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
             if (nrmagg > epsilon(nrmagg)) then
               if (idx <= nr) then
-                if (ilaggr(idx) == -1) then
+                if (ilaggr(idx) == ilaggr_neginit) then
                   ! Now, if both vertices are local, the aggregate is local
                   ! (kinda obvious).
                   nlaggr(iam) = nlaggr(iam) + 1
@@ -284,6 +289,9 @@ contains
                   ilaggr(idx) = nlaggr(iam)
                   wtemp(k)    = w(k)/nrmagg
                   wtemp(idx)  = w(idx)/nrmagg
+                else
+                  write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
+                       &mate(idx),ilaggr(idx)
                 end if
                 nlpairs = nlpairs+1
               else if (idx <= nc) then
@@ -303,7 +311,7 @@ contains
                     ilaggr(k)   = nlaggr(iam)
                     nlpairs = nlpairs+1
                   else
-                    ilaggr(k) = -2
+                    ilaggr(k) = ilaggr_nonlocal
                   end if
                 else
                   ! Use a statistically unbiased tie-breaking rule,
@@ -312,13 +320,13 @@ contains
                   ! Should be a symmetric function.
                   !
                   call desc_a%indxmap%qry_halo_owner(idx,iown,info)
-                  ip    = i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
+                  ip    = amg_i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
                   if (iam == ip) then
                     nlaggr(iam) = nlaggr(iam) + 1
                     ilaggr(k)   = nlaggr(iam)
                     nlpairs = nlpairs+1
                   else
-                    ilaggr(k) = -2
+                    ilaggr(k) = ilaggr_nonlocal
                   end if
                 end if
               end if
@@ -334,6 +342,12 @@ contains
                 nlsingl     = nlsingl + 1
               end if
             end if
+            if (ilaggr(k) == ilaggr_neginit) then
+              write(0,*) iam,' Error: no update to ',k,mate(k),&
+                   & abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
+            end if
+          else
+            if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
           end if
         end if
       end do
@@ -341,7 +355,7 @@ contains
       if (do_timings) call psb_tic(idx_phase3)
 
       ! Ok, now compute offsets, gather halo and fix non-local
-      ! aggregates  (those where ilaggr == -2)
+      ! aggregates  (those where ilaggr == ilaggr_nonlocal)
       call psb_sum(ictxt,nlaggr)
       ntaggr  = sum(nlaggr(0:np-1))
       naggrm1 = sum(nlaggr(0:iam-1))
@@ -356,7 +370,7 @@ contains
       call psb_halo(wtemp,desc_a,info)
       ! Cleanup as yet unmarked entries
       do k=1,nr
-        if (ilaggr(k) == -2) then
+        if (ilaggr(k) == ilaggr_nonlocal) then
           idx = mate(k)
           if (idx > nr) then
             i   = ilaggr(idx)
@@ -368,9 +382,14 @@ contains
           else
             write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
           end if
-        end if
+        else if (ilaggr(k) <0) then
-        if (ilaggr(k) <0) then
+          write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
-          write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
+          write(0,*) iam,'         :             : ',nr,nc,mate(k)
+          if (mate(k) <= nr) then
+            write(0,*) iam,'         :             : ',ilaggr(mate(k)),mate(mate(k)),&
+                 & ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
+          end if
+          flush(0)
         end if
       end do
       if (debug_sync) then
@@ -422,13 +441,11 @@ contains
         nlpairs    = v(3)
 
       end block
-      if (print_statistics) then
+      if (iam == 0) then
-        if (iam == 0) then
+        write(0,*) iam,'Matching statistics: Unmatched nodes ',&
-          write(0,*) 'Matching statistics: Unmatched nodes ',&
+             & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
-               & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
-        end if
       end if
-      
+
       if (display_out_) then
         block
           integer(psb_ipk_) :: idx
@@ -516,9 +533,9 @@ contains
       write(0,*) iam,' :  error from Matching: ',info
     end if
 
-  end subroutine smatchboxp_build_prol
+  end subroutine amg_s_matchboxp_build_prol
 
-  function i_saggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
+  function amg_i_s_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
        & result(iproc)
     !
     ! How to break ties? This
@@ -560,10 +577,10 @@ contains
         iproc = iown
       end if
     end if
-  end function i_saggr_assign
+  end function amg_i_s_aggr_assign
 
 
-  subroutine sbuild_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
+  subroutine amg_s_par_build_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
     use psb_base_mod
     use psb_util_mod
     use iso_c_binding
@@ -612,7 +629,7 @@ contains
       if (iam == 0) write(0,*)' Into build_ahat:'
     end if
     if (do_timings) call psb_tic(idx_bldahat)
-    call build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
+    call amg_par_build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
     if (do_timings) call psb_toc(idx_bldahat)
     if (info /= 0) then
       write(0,*) 'Error from build_ahat ', info
@@ -703,7 +720,7 @@ contains
       !
       if (debug) write(0,*) iam,' buildmatching into PMatchBox:'
       if (do_timings) call psb_tic(idx_cmboxp)
-      call PMatchBox(nr,nz,vlptr,vlind,ewght,&
+      call amg_PMatchBox(nr,nz,vlptr,vlind,ewght,&
            & vnl, mate, iam, np,ictxt,&
            & msgis,msgas,msgprc,ph0t,ph1t,ph2t,ph1crd,ph2crd,info,display_inp)
       if (do_timings) call psb_toc(idx_cmboxp)
@@ -767,9 +784,9 @@ contains
       val(1:n) = tmp(1:n)
     end subroutine fix_order
 
-  end subroutine sbuild_matching
+  end subroutine amg_s_par_build_matching
 
-  subroutine sbuild_ahat(w,a,ahat,desc_a,info,symmetrize)
+  subroutine amg_s_par_build_ahat(w,a,ahat,desc_a,info,symmetrize)
     use psb_base_mod
     implicit none
     real(psb_spk_), intent(in)           :: w(:)
@@ -1005,301 +1022,9 @@ contains
       end block
     end if
 
-  end subroutine sbuild_ahat
+  end subroutine amg_s_par_build_ahat
 
-  subroutine psb_sgtranspose(ain,aout,desc_a,info)
+  subroutine amg_s_PMatchBox(nlver,nledge,verlocptr,verlocind,edgelocweight,&
-    use psb_base_mod
-    implicit none
-    type(psb_lsspmat_type), intent(in)  :: ain
-    type(psb_lsspmat_type), intent(out) :: aout
-    type(psb_desc_type)           :: desc_a
-    integer(psb_ipk_), intent(out) :: info
-
-    !
-    ! BEWARE: This routine works under the assumption
-    ! that the same DESC_A works for both A and A^T, which
-    ! essentially means that A has a symmetric pattern.
-    !
-    type(psb_lsspmat_type) :: atmp, ahalo, aglb
-    type(psb_ls_coo_sparse_mat) :: tmpcoo
-    type(psb_ls_csr_sparse_mat) :: tmpcsr
-    type(psb_ctxt_type) :: ictxt
-    integer(psb_ipk_) :: me, np
-    integer(psb_lpk_) :: i, j, k, nrow, ncol
-    integer(psb_lpk_), allocatable :: ilv(:)
-    character(len=80) :: aname
-    logical, parameter :: debug=.false., dump=.false., debug_sync=.false.
-
-    ictxt = desc_a%get_context()
-    call psb_info(ictxt,me,np)
-
-    nrow = desc_a%get_local_rows()
-    ncol = desc_a%get_local_cols()
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'Start gtranspose '
-    end if
-    call ain%cscnv(tmpcsr,info)
-
-    if (debug) then
-      ilv = [(i,i=1,ncol)]
-      call desc_a%l2gip(ilv,info,owned=.false.)
-      write(aname,'(a,i3.3,a)') 'atmp-preh-',me,'.mtx'
-      call ain%print(fname=aname,head='atmp before haloTest ',iv=ilv)
-    end if
-    if (dump) then
-      call ain%cscnv(atmp,info)
-      call psb_gather(aglb,atmp,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'aglob-prehalo.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-    !call psb_loc_to_glob(tmpcsr%ja,desc_a,info)
-    call atmp%mv_from(tmpcsr)
-
-    if (debug) then
-      write(aname,'(a,i3.3,a)') 'tmpcsr-',me,'.mtx'
-      call atmp%print(fname=aname,head='tmpcsr ',iv=ilv)
-      !call psb_set_debug_level(9999)
-    end if
-
-    ! FIXME THIS NEEDS REWORKING
-    if (debug) write(0,*) me,' Gtranspose into sphalo :',atmp%get_nrows(),atmp%get_ncols()
-    call psb_sphalo(atmp,desc_a,ahalo,info,rowscale=.true.)
-    if (debug) write(0,*) me,' Gtranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols()
-    if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
-
-    if (debug) then
-      write(aname,'(a,i3.3,a)') 'ahalo-',me,'.mtx'
-      call ahalo%print(fname=aname,head='ahalo after haloTest ',iv=ilv)
-      write(aname,'(a,i3.3,a)') 'atmp-h-',me,'.mtx'
-      call atmp%print(fname=aname,head='atmp after haloTest ',iv=ilv)
-    end if
-
-    if (info == psb_success_) call ahalo%free()
-
-    call atmp%cp_to(tmpcoo)
-    call tmpcoo%transp()
-    !call psb_glob_to_loc(tmpcoo%ia,desc_a,info,iact='I')
-    if (debug) write(0,*) 'Before cleanup:',tmpcoo%get_nzeros()
-
-    j = 0
-    do k=1, tmpcoo%get_nzeros()
-      if ((tmpcoo%ia(k) > 0).and.(tmpcoo%ja(k)>0)) then
-        j = j+1
-        tmpcoo%ia(j)  = tmpcoo%ia(k)
-        tmpcoo%ja(j)  = tmpcoo%ja(k)
-        tmpcoo%val(j) = tmpcoo%val(k)
-      end if
-    end do
-    call tmpcoo%set_nzeros(j)
-
-    if (debug) write(0,*) 'After cleanup:',tmpcoo%get_nzeros()
-
-    call ahalo%mv_from(tmpcoo)
-    if (dump) then
-      call psb_gather(aglb,ahalo,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'atran-preclip.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-
-    call ahalo%csclip(aout,info,imax=nrow)
-
-    if (debug) write(0,*) 'After clip:',aout%get_nzeros()
-
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'End gtranspose '
-    end if
-    !call aout%cscnv(info,type='csr')
-
-    if (dump) then
-      write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx'
-      call aout%print(fname=aname,head='atrans ',iv=ilv)
-      call psb_gather(aglb,aout,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'atran.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-  end subroutine psb_sgtranspose
-
-  subroutine psb_shtranspose(ain,aout,desc_a,info)
-    use psb_base_mod
-    implicit none
-    type(psb_lsspmat_type), intent(in)  :: ain
-    type(psb_lsspmat_type), intent(out) :: aout
-    type(psb_desc_type)           :: desc_a
-    integer(psb_ipk_), intent(out) :: info
-
-    !
-    ! BEWARE: This routine works under the assumption
-    ! that the same DESC_A works for both A and A^T, which
-    ! essentially means that A has a symmetric pattern.
-    !
-    type(psb_lsspmat_type) :: atmp, ahalo, aglb
-    type(psb_ls_coo_sparse_mat) :: tmpcoo, tmpc1, tmpc2, tmpch
-    type(psb_ls_csr_sparse_mat) :: tmpcsr
-    integer(psb_ipk_) :: nz1, nz2, nzh, nz
-    type(psb_ctxt_type) :: ictxt
-    integer(psb_ipk_) :: me, np
-    integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz
-    integer(psb_lpk_), allocatable :: ilv(:)
-    character(len=80) :: aname
-    logical, parameter :: debug=.false., dump=.false., debug_sync=.false.
-
-    ictxt = desc_a%get_context()
-    call psb_info(ictxt,me,np)
-
-    nrow = desc_a%get_local_rows()
-    ncol = desc_a%get_local_cols()
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'Start htranspose '
-    end if
-    call ain%cscnv(tmpcsr,info)
-
-    if (debug) then
-      ilv = [(i,i=1,ncol)]
-      call desc_a%l2gip(ilv,info,owned=.false.)
-      write(aname,'(a,i3.3,a)') 'atmp-preh-',me,'.mtx'
-      call ain%print(fname=aname,head='atmp before haloTest ',iv=ilv)
-    end if
-    if (dump) then
-      call ain%cscnv(atmp,info)
-      call psb_gather(aglb,atmp,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'aglob-prehalo.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-    !call psb_loc_to_glob(tmpcsr%ja,desc_a,info)
-    call atmp%mv_from(tmpcsr)
-
-    if (debug) then
-      write(aname,'(a,i3.3,a)') 'tmpcsr-',me,'.mtx'
-      call atmp%print(fname=aname,head='tmpcsr ',iv=ilv)
-      !call psb_set_debug_level(9999)
-    end if
-
-    ! FIXME THIS NEEDS REWORKING
-    if (debug) write(0,*) me,' Htranspose into sphalo :',atmp%get_nrows(),atmp%get_ncols()
-    if (.true.) then
-      call psb_sphalo(atmp,desc_a,ahalo,info, outfmt='coo  ')
-      call atmp%mv_to(tmpc1)
-      call ahalo%mv_to(tmpch)
-      nz1 = tmpc1%get_nzeros()
-      call psb_loc_to_glob(tmpc1%ia(1:nz1),desc_a,info,iact='I')
-      call psb_loc_to_glob(tmpc1%ja(1:nz1),desc_a,info,iact='I')
-      nzh = tmpch%get_nzeros()
-      call psb_loc_to_glob(tmpch%ia(1:nzh),desc_a,info,iact='I')
-      call psb_loc_to_glob(tmpch%ja(1:nzh),desc_a,info,iact='I')
-      nlz = nz1+nzh
-      call tmpcoo%allocate(ncol,ncol,nlz)
-      tmpcoo%ia(1:nz1) = tmpc1%ia(1:nz1)
-      tmpcoo%ja(1:nz1) = tmpc1%ja(1:nz1)
-      tmpcoo%val(1:nz1) = tmpc1%val(1:nz1)
-      tmpcoo%ia(nz1+1:nz1+nzh) = tmpch%ia(1:nzh)
-      tmpcoo%ja(nz1+1:nz1+nzh) = tmpch%ja(1:nzh)
-      tmpcoo%val(nz1+1:nz1+nzh) = tmpch%val(1:nzh)
-      call tmpcoo%set_nzeros(nlz)
-      call tmpcoo%transp()
-      nz = tmpcoo%get_nzeros()
-      call psb_glob_to_loc(tmpcoo%ia(1:nz),desc_a,info,iact='I')
-      call psb_glob_to_loc(tmpcoo%ja(1:nz),desc_a,info,iact='I')
-      if (.true.) then
-        call tmpcoo%clean_negidx(info)
-      else
-        j = 0
-        do k=1, tmpcoo%get_nzeros()
-          if ((tmpcoo%ia(k) > 0).and.(tmpcoo%ja(k)>0)) then
-            j = j+1
-            tmpcoo%ia(j)  = tmpcoo%ia(k)
-            tmpcoo%ja(j)  = tmpcoo%ja(k)
-            tmpcoo%val(j) = tmpcoo%val(k)
-          end if
-        end do
-        call tmpcoo%set_nzeros(j)
-      end if
-      call ahalo%mv_from(tmpcoo)
-      call ahalo%csclip(aout,info,imax=nrow)
-
-    else
-      call psb_sphalo(atmp,desc_a,ahalo,info, rowscale=.true.)
-      if (debug) write(0,*) me,' Htranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols()
-      if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
-
-      if (debug) then
-        write(aname,'(a,i3.3,a)') 'ahalo-',me,'.mtx'
-        call ahalo%print(fname=aname,head='ahalo after haloTest ',iv=ilv)
-        write(aname,'(a,i3.3,a)') 'atmp-h-',me,'.mtx'
-        call atmp%print(fname=aname,head='atmp after haloTest ',iv=ilv)
-      end if
-
-      if (info == psb_success_) call ahalo%free()
-
-      call atmp%cp_to(tmpcoo)
-      call tmpcoo%transp()
-      if (debug) write(0,*) 'Before cleanup:',tmpcoo%get_nzeros()
-      if (.true.) then
-        call tmpcoo%clean_negidx(info)
-      else
-
-        j = 0
-        do k=1, tmpcoo%get_nzeros()
-          if ((tmpcoo%ia(k) > 0).and.(tmpcoo%ja(k)>0)) then
-            j = j+1
-            tmpcoo%ia(j)  = tmpcoo%ia(k)
-            tmpcoo%ja(j)  = tmpcoo%ja(k)
-            tmpcoo%val(j) = tmpcoo%val(k)
-          end if
-        end do
-        call tmpcoo%set_nzeros(j)
-      end if
-
-      if (debug) write(0,*) 'After cleanup:',tmpcoo%get_nzeros()
-
-      call ahalo%mv_from(tmpcoo)
-      if (dump) then
-        call psb_gather(aglb,ahalo,desc_a,info)
-        if (me==psb_root_) then
-          write(aname,'(a,i3.3,a)') 'atran-preclip.mtx'
-          call aglb%print(fname=aname,head='Test ')
-        end if
-      end if
-
-
-      call ahalo%csclip(aout,info,imax=nrow)
-    end if
-
-    if (debug) write(0,*) 'After clip:',aout%get_nzeros()
-
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'End htranspose '
-    end if
-    !call aout%cscnv(info,type='csr')
-
-    if (dump) then
-      write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx'
-      call aout%print(fname=aname,head='atrans ',iv=ilv)
-      call psb_gather(aglb,aout,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'atran.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-  end subroutine psb_shtranspose
-
-  subroutine sPMatchBox(nlver,nledge,verlocptr,verlocind,edgelocweight,&
        & verdistance, mate, myrank, numprocs, ictxt,&
        & msgindsent,msgactualsent,msgpercent,&
        & ph0_time, ph1_time, ph2_time, ph1_card, ph2_card,info,display_inp)
@@ -1434,6 +1159,6 @@ contains
     end if
     where(mate>=0) mate = mate + 1
 
-  end subroutine sPMatchBox
+  end subroutine amg_s_PMatchBox
 
-end module smatchboxp_mod
+end module amg_s_matchboxp_mod

amgprec/amg_s_mumps_solver.F90

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

amgprec/amg_s_onelev_mod.f90

@@ -190,6 +190,7 @@ module amg_s_onelev_mod
     procedure, pass(lv) :: descr   => amg_s_base_onelev_descr
     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
@@ -258,7 +259,7 @@ module amg_s_onelev_mod
   end interface
 
   interface
-    subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
+    subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
       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
@@ -269,6 +270,7 @@ module amg_s_onelev_mod
       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
     end subroutine amg_s_base_onelev_descr
   end interface
 
@@ -285,7 +287,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, &
@@ -297,6 +299,18 @@ interface
     end subroutine amg_s_base_onelev_free
   end interface
 
+  interface
+    subroutine amg_s_base_onelev_free_smoothers(lv,info)
+      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
+           & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
+           & psb_ipk_, psb_epk_, psb_desc_type
+      implicit none
+
+      class(amg_s_onelev_type), intent(inout) :: lv
+      integer(psb_ipk_), intent(out)                :: info
+    end subroutine amg_s_base_onelev_free_smoothers
+  end interface
+
   interface
     subroutine amg_s_base_onelev_check(lv,info)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &

amgprec/amg_s_parmatch_aggregator_mod.F90

@@ -118,7 +118,7 @@
 
 module amg_s_parmatch_aggregator_mod
   use amg_s_base_aggregator_mod
-  use smatchboxp_mod
+  use amg_s_matchboxp_mod
 #if defined(SERIAL_MPI)
   type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
   end type amg_s_parmatch_aggregator_type
@@ -132,8 +132,6 @@ module amg_s_parmatch_aggregator_mod
     type(psb_sspmat_type), allocatable  :: prol, restr
     type(psb_sspmat_type), allocatable  :: ac, base_a, rwa
     type(psb_desc_type), allocatable    :: desc_ac, desc_ax, base_desc, rwdesc
-    integer(psb_ipk_) :: max_csize
-    integer(psb_ipk_) :: max_nlevels
     logical           :: reproducible_matching = .false.
     logical           :: need_symmetrize       = .false.
     logical           :: unsmoothed_hierarchy  = .true.
@@ -143,18 +141,18 @@ module amg_s_parmatch_aggregator_mod
     procedure, pass(ag) :: mat_asb      => amg_s_parmatch_aggregator_mat_asb
     procedure, pass(ag) :: inner_mat_asb      => amg_s_parmatch_aggregator_inner_mat_asb
     procedure, pass(ag) :: bld_map      => amg_s_parmatch_aggregator_bld_map
-    procedure, pass(ag) :: csetc        => s_parmatch_aggr_csetc
+    procedure, pass(ag) :: csetc        => amg_s_parmatch_aggr_csetc
-    procedure, pass(ag) :: cseti        => s_parmatch_aggr_cseti
+    procedure, pass(ag) :: cseti        => amg_s_parmatch_aggr_cseti
-    procedure, pass(ag) :: default      => s_parmatch_aggr_set_default
+    procedure, pass(ag) :: default      => amg_s_parmatch_aggr_set_default
-    procedure, pass(ag) :: sizeof       => s_parmatch_aggregator_sizeof
+    procedure, pass(ag) :: sizeof       => amg_s_parmatch_aggregator_sizeof
-    procedure, pass(ag) :: update_next  => s_parmatch_aggregator_update_next
+    procedure, pass(ag) :: update_next  => amg_s_parmatch_aggregator_update_next
-    procedure, pass(ag) :: bld_wnxt     => s_parmatch_bld_wnxt
+    procedure, pass(ag) :: bld_wnxt     => amg_s_parmatch_bld_wnxt
-    procedure, pass(ag) :: bld_default_w    => s_bld_default_w
+    procedure, pass(ag) :: bld_default_w    => amg_s_bld_default_w
-    procedure, pass(ag) :: set_c_default_w  => s_set_prm_c_default_w
+    procedure, pass(ag) :: set_c_default_w  => amg_s_set_prm_c_default_w
-    procedure, pass(ag) :: descr        => s_parmatch_aggregator_descr
+    procedure, pass(ag) :: descr        => amg_s_parmatch_aggregator_descr
-    procedure, pass(ag) :: clone        => s_parmatch_aggregator_clone
+    procedure, pass(ag) :: clone        => amg_s_parmatch_aggregator_clone
-    procedure, pass(ag) :: free         => s_parmatch_aggregator_free
+    procedure, pass(ag) :: free         => amg_s_parmatch_aggregator_free
-    procedure, nopass   :: fmt          => s_parmatch_aggregator_fmt
+    procedure, nopass   :: fmt          => amg_s_parmatch_aggregator_fmt
     procedure, nopass   :: xt_desc      => amg_s_parmatch_aggregator_xt_desc
   end type amg_s_parmatch_aggregator_type
 
@@ -320,7 +318,7 @@ module amg_s_parmatch_aggregator_mod
 
 contains
 
-  subroutine s_bld_default_w(ag,nr)
+  subroutine amg_s_bld_default_w(ag,nr)
     use psb_realloc_mod
     implicit none
     class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -330,9 +328,9 @@ contains
     if (info /= psb_success_) return
     ag%w = done
     !call ag%set_c_default_w()
-  end subroutine s_bld_default_w
+  end subroutine amg_s_bld_default_w
 
-  subroutine s_set_prm_c_default_w(ag)
+  subroutine amg_s_set_prm_c_default_w(ag)
     use psb_realloc_mod
     use iso_c_binding
     implicit none
@@ -342,9 +340,9 @@ contains
     !write(0,*) 'prm_c_deafult_w '
     call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
 
-  end subroutine s_set_prm_c_default_w
+  end subroutine amg_s_set_prm_c_default_w
 
-  subroutine s_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
+  subroutine amg_s_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
     use psb_realloc_mod
     implicit none
     class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -358,14 +356,14 @@ contains
     !write(0,*) 'Executing bld_wnxt ',nx
     call psb_realloc(nx,ag%w_nxt,info)
 
-  end subroutine s_parmatch_bld_wnxt
+  end subroutine amg_s_parmatch_bld_wnxt
 
-  function s_parmatch_aggregator_fmt() result(val)
+  function amg_s_parmatch_aggregator_fmt() result(val)
     implicit none
     character(len=32)  :: val
 
     val = "Parallel Matching aggregation"
-  end function s_parmatch_aggregator_fmt
+  end function amg_s_parmatch_aggregator_fmt
 
   function amg_s_parmatch_aggregator_xt_desc() result(val)
     implicit none
@@ -374,7 +372,7 @@ contains
     val = .true.
   end function amg_s_parmatch_aggregator_xt_desc
 
-  function s_parmatch_aggregator_sizeof(ag) result(val)
+  function amg_s_parmatch_aggregator_sizeof(ag) result(val)
     use psb_realloc_mod
     implicit none
     class(amg_s_parmatch_aggregator_type), intent(in)  :: ag
@@ -390,23 +388,30 @@ contains
     if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
     if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
 
-  end function s_parmatch_aggregator_sizeof
+  end function amg_s_parmatch_aggregator_sizeof
 
-  subroutine  s_parmatch_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_s_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none
     class(amg_s_parmatch_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
+    character(1024)    :: prefix_
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout,*) 'Parallel Matching Aggregator'
+    write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
-    write(iout,*) '   Number of matching  sweeps: ',ag%n_sweeps
+    write(iout,*) trim(prefix_),' ','   Number of matching  sweeps: ',ag%n_sweeps
-    write(iout,*) '   Matching algorithm         : MatchBoxP (PREIS)'
+    write(iout,*) trim(prefix_),' ','   Matching algorithm         : MatchBoxP (PREIS)'
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info)
+    call parms%mldescr(iout,info,prefix=prefix)
 
     return
-  end subroutine s_parmatch_aggregator_descr
+  end subroutine amg_s_parmatch_aggregator_descr
 
   function is_legal_malg(alg) result(val)
     logical :: val
@@ -437,7 +442,7 @@ contains
   end function is_legal_nlevels
 
 
-  subroutine  s_parmatch_aggregator_update_next(ag,agnext,info)
+  subroutine  amg_s_parmatch_aggregator_update_next(ag,agnext,info)
     use psb_realloc_mod
     implicit none
     class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -452,10 +457,10 @@ contains
            & 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))&
+!!$      if (.not.is_legal_csize(agnext%max_csize))&
-           & agnext%max_csize    = ag%max_csize
+!!$           & agnext%max_csize    = ag%max_csize
-      if (.not.is_legal_nlevels(agnext%max_nlevels))&
+!!$      if (.not.is_legal_nlevels(agnext%max_nlevels))&
-           & agnext%max_nlevels  = ag%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)
@@ -470,9 +475,9 @@ contains
       ! What should we do here?
     end select
     info = 0
-  end subroutine s_parmatch_aggregator_update_next
+  end subroutine amg_s_parmatch_aggregator_update_next
 
-  subroutine s_parmatch_aggr_csetc(ag,what,val,info,idx)
+  subroutine amg_s_parmatch_aggr_csetc(ag,what,val,info,idx)
 
     Implicit None
 
@@ -514,9 +519,9 @@ contains
       ! Do nothing
     end select
     return
-  end subroutine s_parmatch_aggr_csetc
+  end subroutine amg_s_parmatch_aggr_csetc
 
-  subroutine s_parmatch_aggr_cseti(ag,what,val,info,idx)
+  subroutine amg_s_parmatch_aggr_cseti(ag,what,val,info,idx)
 
     Implicit None
 
@@ -540,10 +545,6 @@ contains
     case('AGGR_SIZE')
       ag%orig_aggr_size = val
       ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
-    case('PRMC_MAX_CSIZE')
-      ag%max_csize=val
-    case('PRMC_MAX_NLEVELS')
-      ag%max_nlevels=val
     case('PRMC_W_SIZE')
       call ag%bld_default_w(val)
     case('PRMC_REPRODUCIBLE_MATCHING')
@@ -556,9 +557,9 @@ contains
       ! Do nothing
     end select
     return
-  end subroutine s_parmatch_aggr_cseti
+  end subroutine amg_s_parmatch_aggr_cseti
 
-  subroutine s_parmatch_aggr_set_default(ag)
+  subroutine amg_s_parmatch_aggr_set_default(ag)
 
     Implicit None
 
@@ -569,8 +570,8 @@ contains
     ag%matching_alg  = 0
     ag%n_sweeps      = 1
     ag%jacobi_sweeps = 0
-    ag%max_nlevels   = 36
+!!$    ag%max_nlevels   = 36
-    ag%max_csize     = -1
+!!$    ag%max_csize     = -1
     !
     ! Apparently BootCMatch works better
     ! by keeping all entries
@@ -579,9 +580,9 @@ contains
 
     return
 
-  end subroutine s_parmatch_aggr_set_default
+  end subroutine amg_s_parmatch_aggr_set_default
 
-  subroutine  s_parmatch_aggregator_free(ag,info)
+  subroutine  amg_s_parmatch_aggregator_free(ag,info)
     use iso_c_binding
     implicit none
     class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
@@ -618,9 +619,9 @@ contains
       call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
     end if
 
-  end subroutine s_parmatch_aggregator_free
+  end subroutine amg_s_parmatch_aggregator_free
 
-  subroutine  s_parmatch_aggregator_clone(ag,agnext,info)
+  subroutine  amg_s_parmatch_aggregator_clone(ag,agnext,info)
     implicit none
     class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
     class(amg_s_base_aggregator_type), allocatable, intent(inout) :: agnext
@@ -640,7 +641,7 @@ contains
       ! Should never ever get here
       info = -1
     end select
-  end subroutine s_parmatch_aggregator_clone
+  end subroutine amg_s_parmatch_aggregator_clone
 
   subroutine  amg_s_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
        & op_restr,op_prol,map,info)

amgprec/amg_s_prec_type.f90

@@ -135,7 +135,9 @@ 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
   end type amg_sprec_type
 
@@ -155,15 +157,16 @@ module amg_s_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity)
+    subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity,prefix)
       import :: amg_sprec_type, psb_ipk_
       implicit none
       ! Arguments
-      class(amg_sprec_type), intent(in)      :: prec
+      class(amg_sprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out) :: info
+      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
     end subroutine amg_sfile_prec_descr
   end interface
 
@@ -344,6 +347,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
@@ -617,6 +628,68 @@ contains
 
   end subroutine amg_s_prec_free
 
+  subroutine amg_s_smoothers_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_sprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_s_smoothers_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    if (allocated(prec%precv)) then
+      do i=1,size(prec%precv)
+        call prec%precv(i)%free_smoothers(info)
+      end do
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_s_smoothers_free
+
+  subroutine amg_s_hierarchy_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_sprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_s_hierarchy_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    me=-1
+    write(0,*) 'Missing implementation '
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_s_hierarchy_free
 
 
   !

amgprec/amg_s_slu_solver.F90

@@ -385,20 +385,22 @@ contains
   
   end subroutine s_slu_solver_finalize
 
-  subroutine s_slu_solver_descr(sv,info,iout,coarse)
+  subroutine s_slu_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_s_slu_solver_type), intent(in) :: sv
-    integer, intent(out)                     :: info
+    integer, intent(out)                       :: info
-    integer, intent(in), optional            :: iout
+    integer, intent(in), optional              :: iout
-    logical, intent(in), optional       :: coarse
+    logical, intent(in), optional              :: coarse
+    character(len=*), intent(in), optional     :: prefix
 
     ! Local variables
     integer      :: err_act
     character(len=20), parameter :: name='amg_s_slu_solver_descr'
     integer :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -407,8 +409,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
     
-    write(iout_,*) '  SuperLU Sparse Factorization Solver. '
+    write(iout_,*) trim(prefix_), '  SuperLU Sparse Factorization Solver. '
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_s_symdec_aggregator_mod.f90

@@ -88,16 +88,25 @@ contains
     val = "Symmetric Decoupled aggregation"
   end function amg_s_symdec_aggregator_fmt
   
-  subroutine  amg_s_symdec_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_s_symdec_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none 
     class(amg_s_symdec_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
 
-    write(iout,*) 'Decoupled Aggregator locally-symmetrized'
+    character(1024)    :: prefix_
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+
-    call parms%mldescr(iout,info)
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
+    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info,prefix=prefix)
     
     return
   end subroutine amg_s_symdec_aggregator_descr

amgprec/amg_z_ainv_solver.F90

@@ -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), allocatable, intent(inout) :: svout
+      integer(psb_ipk_), intent(out)                            :: info
+    end subroutine amg_z_ainv_solver_clone_settings
+  end interface
 
   interface
     subroutine amg_z_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
@@ -198,7 +209,7 @@ module amg_z_ainv_solver
 !!$  end interface
 
   interface
-    subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse)
+    subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
 
       Implicit None
@@ -208,7 +219,7 @@ module amg_z_ainv_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-
+      character(len=*), intent(in), optional  :: prefix
     end subroutine amg_z_ainv_solver_descr
   end interface
 

amgprec/amg_z_as_smoother.f90

@@ -396,21 +396,23 @@ contains
   end subroutine z_as_smoother_default
 
 
-  subroutine z_as_smoother_descr(sm,info,iout,coarse)
+  subroutine z_as_smoother_descr(sm,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_z_as_smoother_type), intent(in) :: sm
-    integer(psb_ipk_), intent(out)                      :: info
+    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional             :: iout
+    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional             :: coarse
+    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_as_smoother_descr'
     integer(psb_ipk_) :: iout_
     logical      :: coarse_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -424,16 +426,21 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (.not.coarse_) then 
-      write(iout_,*) '  Additive Schwarz with  ',&
+      write(iout_,*) trim(prefix_), '  Additive Schwarz with  ',&
            &  sm%novr, ' overlap layers.'
-      write(iout_,*) '  Restrictor:  ',restrict_names(sm%restr)
+      write(iout_,*) trim(prefix_), '  Restrictor:  ',restrict_names(sm%restr)
-      write(iout_,*) '  Prolongator: ',prolong_names(sm%prol)
+      write(iout_,*) trim(prefix_), '  Prolongator: ',prolong_names(sm%prol)
-      write(iout_,*) '  Local solver:'
+      write(iout_,*) trim(prefix_), '  Local solver:'
     endif
     if (allocated(sm%sv)) then 
-      call sm%sv%descr(info,iout_,coarse=coarse)
+      call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
     end if
 
     call psb_erractionrestore(err_act)

amgprec/amg_z_base_aggregator_mod.f90

@@ -275,15 +275,22 @@ contains
     val = .false.
   end function amg_z_base_aggregator_xt_desc
 
-  subroutine  amg_z_base_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_z_base_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none 
     class(amg_z_base_aggregator_type), intent(in) :: ag
     type(amg_dml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
+    character(1024)    :: prefix_
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info)
+    call parms%mldescr(iout,info,prefix=prefix)
     
     return
   end subroutine amg_z_base_aggregator_descr

amgprec/amg_z_base_smoother_mod.f90

@@ -272,7 +272,7 @@ module amg_z_base_smoother_mod
   end interface
   
   interface 
-    subroutine amg_z_base_smoother_descr(sm,info,iout,coarse)
+    subroutine amg_z_base_smoother_descr(sm,info,iout,coarse,prefix)
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
            & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
            & amg_z_base_smoother_type, psb_ipk_
@@ -281,6 +281,7 @@ module amg_z_base_smoother_mod
       integer(psb_ipk_), intent(out)                :: info
       integer(psb_ipk_), intent(in), optional       :: iout
       logical, intent(in), optional                 :: coarse
+      character(len=*), intent(in), optional        :: prefix
     end subroutine amg_z_base_smoother_descr
   end interface
   

amgprec/amg_z_base_solver_mod.f90

@@ -270,7 +270,7 @@ module amg_z_base_solver_mod
   end interface
   
   interface
-    subroutine amg_z_base_solver_descr(sv,info,iout,coarse)
+    subroutine amg_z_base_solver_descr(sv,info,iout,coarse,prefix)
       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, psb_ipk_
@@ -281,7 +281,7 @@ module amg_z_base_solver_mod
       integer(psb_ipk_), intent(out)              :: info
       integer(psb_ipk_), intent(in), optional     :: iout
       logical, intent(in), optional               :: coarse
-
+      character(len=*), intent(in), optional      :: prefix
     end subroutine amg_z_base_solver_descr
   end interface 
   

amgprec/amg_z_dec_aggregator_mod.f90

@@ -184,16 +184,23 @@ contains
     val = "Decoupled aggregation"
   end function amg_z_dec_aggregator_fmt
   
-  subroutine  amg_z_dec_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_z_dec_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none 
     class(amg_z_dec_aggregator_type), intent(in) :: ag
     type(amg_dml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
+    character(1024)    :: prefix_
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout,*) 'Decoupled Aggregator'
+    write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
-    call parms%mldescr(iout,info)
+    call parms%mldescr(iout,info,prefix=prefix)
     
     return
   end subroutine amg_z_dec_aggregator_descr

amgprec/amg_z_diag_solver.f90

@@ -219,7 +219,7 @@ contains
 
   end subroutine z_diag_solver_free
 
-  subroutine z_diag_solver_descr(sv,info,iout,coarse)
+  subroutine z_diag_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -228,11 +228,13 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
+    character(len=*), intent(in), optional      :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_z_diag_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -240,8 +242,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    
+    if (present(prefix)) then
-    write(iout_,*) '  Diagonal local solver '
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout_,*) trim(prefix_), '  Diagonal local solver '
 
     return
 
@@ -352,7 +359,7 @@ module amg_z_l1_diag_solver
   
 contains
 
-  subroutine z_l1_diag_solver_descr(sv,info,iout,coarse)
+  subroutine z_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -361,11 +368,13 @@ contains
     integer(psb_ipk_), intent(out)              :: info
     integer(psb_ipk_), intent(in), optional     :: iout
     logical, intent(in), optional               :: coarse
+    character(len=*), intent(in), optional  :: prefix
 
     ! Local variables
     integer(psb_ipk_)      :: err_act
     character(len=20), parameter :: name='amg_z_l1_diag_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -373,8 +382,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
-    
+    if (present(prefix)) then
-    write(iout_,*) '  L1 Diagonal solver '
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout_,*) trim(prefix_), '  L1 Diagonal solver '
 
     return
 

amgprec/amg_z_gs_solver.f90

@@ -433,20 +433,22 @@ contains
     return
   end subroutine z_gs_solver_free
 
-  subroutine z_gs_solver_descr(sv,info,iout,coarse)
+  subroutine z_gs_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_z_gs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional    :: iout
+    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional       :: coarse
+    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_gs_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -455,12 +457,17 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) '  Forward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) trim(prefix_), '  Forward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     
@@ -526,20 +533,22 @@ contains
     val = .true.
   end function z_gs_solver_is_iterative
     
-  subroutine z_bwgs_solver_descr(sv,info,iout,coarse)
+  subroutine z_bwgs_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_z_bwgs_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(out)              :: info
-    integer(psb_ipk_), intent(in), optional    :: iout
+    integer(psb_ipk_), intent(in), optional     :: iout
-    logical, intent(in), optional       :: coarse
+    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_bwgs_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -548,12 +557,17 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (sv%eps<=dzero) then 
-      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  ',&
+      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  ',&
            &  sv%sweeps,' sweeps'
     else
-      write(iout_,*) '  Backward Gauss-Seidel iterative solver with  tolerance',&
+      write(iout_,*) trim(prefix_), '  Backward Gauss-Seidel iterative solver with  tolerance',&
            &  sv%eps,' and maxit', sv%sweeps
     end if
     

amgprec/amg_z_id_solver.f90

@@ -157,7 +157,7 @@ contains
     return
   end subroutine z_id_solver_free
 
-  subroutine z_id_solver_descr(sv,info,iout,coarse)
+  subroutine z_id_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -165,12 +165,14 @@ contains
     class(amg_z_id_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)            :: info
     integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional       :: coarse
+    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_id_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     info = psb_success_
     if (present(iout)) then 
@@ -178,8 +180,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
     
-    write(iout_,*) '  Identity local solver '
+    write(iout_,*) trim(prefix_), '  Identity local solver '
 
     return
 

amgprec/amg_z_ilu_solver.f90

@@ -406,7 +406,7 @@ contains
     return
   end subroutine z_ilu_solver_free
 
-  subroutine z_ilu_solver_descr(sv,info,iout,coarse)
+  subroutine z_ilu_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -414,12 +414,14 @@ contains
     class(amg_z_ilu_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional       :: coarse
+    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_ilu_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -428,15 +430,20 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
-    write(iout_,*) '  Incomplete factorization solver: ',&
+    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_)      
-      write(iout_,*) '  Fill level:',sv%fill_in
+      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
     case(psb_ilu_t_)         
-      write(iout_,*) '  Fill level:',sv%fill_in
+      write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-      write(iout_,*) '  Fill threshold :',sv%thresh
+      write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
     end select
 
     call psb_erractionrestore(err_act)

amgprec/amg_z_invk_solver.f90

@@ -52,6 +52,7 @@ module amg_z_invk_solver
   contains
     procedure, pass(sv) :: check   => amg_z_invk_solver_check
     procedure, pass(sv) :: clone   => amg_z_invk_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_z_invk_solver_clone_settings
     procedure, pass(sv) :: build   => amg_z_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_z_invk_solver_cseti
     procedure, pass(sv) :: descr   => amg_z_invk_solver_descr
@@ -73,6 +74,17 @@ module amg_z_invk_solver
     end subroutine amg_z_invk_solver_clone
   end interface
 
+  interface
+    subroutine amg_z_invk_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
+       & amg_z_base_solver_type, psb_dpk_, amg_z_invk_solver_type, psb_ipk_
+      Implicit None
+      class(amg_z_invk_solver_type), intent(inout)              :: sv
+      class(amg_z_base_solver_type), allocatable, 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, &
@@ -123,7 +135,7 @@ module amg_z_invk_solver
   end interface
 
   interface
-    subroutine amg_z_invk_solver_descr(sv,info,iout,coarse)
+    subroutine amg_z_invk_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_dpk_, amg_z_invk_solver_type, psb_ipk_
 
       Implicit None
@@ -133,7 +145,7 @@ module amg_z_invk_solver
       integer(psb_ipk_), intent(out)            :: info
       integer(psb_ipk_), intent(in), optional   :: iout
       logical, intent(in), optional             :: coarse
-
+      character(len=*), intent(in), optional  :: prefix
     end subroutine amg_z_invk_solver_descr
   end interface
 

amgprec/amg_z_invt_solver.f90

@@ -52,6 +52,7 @@ module amg_z_invt_solver
   contains
     procedure, pass(sv) :: check   => amg_z_invt_solver_check
     procedure, pass(sv) :: clone   => amg_z_invt_solver_clone
+    procedure, pass(sv) :: clone_settings   => amg_z_invt_solver_clone_settings
     procedure, pass(sv) :: build   => amg_z_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_z_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_z_invt_solver_csetr
@@ -73,6 +74,17 @@ module amg_z_invt_solver
     end subroutine amg_z_invt_solver_clone
   end interface
 
+  interface
+    subroutine amg_z_invt_solver_clone_settings(sv,svout,info)
+      import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
+       & amg_z_base_solver_type, psb_dpk_, amg_z_invt_solver_type, psb_ipk_
+      Implicit None
+      class(amg_z_invt_solver_type), intent(inout)              :: sv
+      class(amg_z_base_solver_type), allocatable, 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, &
@@ -134,16 +146,17 @@ module amg_z_invt_solver
   end interface
 
   interface
-    subroutine amg_z_invt_solver_descr(sv,info,iout,coarse)
+    subroutine amg_z_invt_solver_descr(sv,info,iout,coarse,prefix)
       import :: psb_dpk_, amg_z_invt_solver_type, psb_ipk_
 
       Implicit None
 
       ! Arguments
       class(amg_z_invt_solver_type), intent(in) :: sv
-      integer(psb_ipk_), intent(out)            :: info
+      integer(psb_ipk_), intent(out)              :: info
-      integer(psb_ipk_), intent(in), optional   :: iout
+      integer(psb_ipk_), intent(in), optional     :: iout
-      logical, intent(in), optional             :: coarse
+      logical, intent(in), optional               :: coarse
+      character(len=*), intent(in), optional      :: prefix
 
     end subroutine amg_z_invt_solver_descr
   end interface

amgprec/amg_z_jac_smoother.f90

@@ -219,12 +219,13 @@ module amg_z_jac_smoother
   end interface
 
   interface
-    subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse)
+    subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse,prefix)
       import :: amg_z_jac_smoother_type, psb_ipk_
       class(amg_z_jac_smoother_type), intent(in) :: sm
       integer(psb_ipk_), intent(out)               :: info
       integer(psb_ipk_), intent(in), optional      :: iout
-      logical, intent(in), optional              :: coarse
+      logical, intent(in), optional                :: coarse
+      character(len=*), intent(in), optional       :: prefix
     end subroutine amg_z_jac_smoother_descr
   end interface
 
@@ -313,12 +314,13 @@ module amg_z_jac_smoother
   end interface
 
   interface
-    subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse)
+    subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
       import :: amg_z_l1_jac_smoother_type, psb_ipk_
       class(amg_z_l1_jac_smoother_type), intent(in) :: sm
-      integer(psb_ipk_), intent(out)               :: info
+      integer(psb_ipk_), intent(out)                  :: info
-      integer(psb_ipk_), intent(in), optional      :: iout
+      integer(psb_ipk_), intent(in), optional         :: iout
-      logical, intent(in), optional              :: coarse
+      logical, intent(in), optional                   :: coarse
+      character(len=*), intent(in), optional          :: prefix
     end subroutine amg_z_l1_jac_smoother_descr
   end interface
 

amgprec/amg_z_jac_solver.f90

@@ -0,0 +1,582 @@
+!  
+!   
+!                             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()
+    call sv%dv%free(info)
+    if (allocated(sv%d)) deallocate(sv%d)
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine z_jac_solver_free
+
+  subroutine z_jac_solver_descr(sv,info,iout,coarse,prefix)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_jac_solver_type), intent(in) :: sv
+    integer(psb_ipk_), intent(out)            :: info
+    integer(psb_ipk_), intent(in), optional   :: iout
+    logical, intent(in), optional             :: coarse
+    character(len=*), intent(in), optional    :: prefix
+
+    ! Local variables
+    integer(psb_ipk_)      :: err_act
+    character(len=20), parameter :: name='amg_z_jac_solver_descr'
+    integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+    if (present(iout)) then 
+      iout_ = iout 
+    else
+      iout_ = psb_out_unit
+    endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    if (sv%eps<=dzero) then 
+      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  ',&
+           &  sv%sweeps,' sweeps'
+    else
+      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  tolerance',&
+           &  sv%eps,' and maxit', sv%sweeps
+    end if
+    
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine z_jac_solver_descr
+
+  function z_jac_solver_get_nzeros(sv) result(val)
+
+    implicit none 
+    ! Arguments
+    class(amg_z_jac_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+    integer(psb_ipk_)        :: i
+    
+    val = 0 
+    val = val + sv%a%get_nzeros()
+    val = val + sv%dv%get_nrows()
+
+    return
+  end function z_jac_solver_get_nzeros
+
+  function z_jac_solver_sizeof(sv) result(val)
+
+    implicit none 
+    ! Arguments
+    class(amg_z_jac_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+    integer(psb_ipk_)        :: i
+
+    val = psb_sizeof_ip 
+    val = val + sv%a%sizeof()
+    val = val + sv%dv%sizeof()
+
+    return
+  end function z_jac_solver_sizeof
+
+  function z_jac_solver_get_fmt() result(val)
+    implicit none 
+    character(len=32)  :: val
+
+    val = "Jacobi solver"
+  end function z_jac_solver_get_fmt
+
+  function z_jac_solver_get_id() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = amg_jac_
+  end function z_jac_solver_get_id
+
+  !
+  ! If this is true, then the solver needs a starting
+  ! guess. Currently only handled in JAC smoother. 
+  ! 
+  function z_jac_solver_is_iterative() result(val)
+    implicit none 
+    logical  :: val
+
+    val = .true.
+  end function z_jac_solver_is_iterative
+    
+  function z_jac_solver_get_wrksize() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = 2
+  end function z_jac_solver_get_wrksize
+
+  subroutine z_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_l1_jac_solver_type), intent(in) :: sv
+    integer(psb_ipk_), intent(out)            :: info
+    integer(psb_ipk_), intent(in), optional   :: iout
+    logical, intent(in), optional             :: coarse
+    character(len=*), intent(in), optional    :: prefix
+
+    ! Local variables
+    integer(psb_ipk_)      :: err_act
+    character(len=20), parameter :: name='amg_z_l1_jac_solver_descr'
+    integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+    if (present(iout)) then 
+      iout_ = iout 
+    else
+      iout_ = psb_out_unit
+    endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    if (sv%eps<=dzero) then 
+      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  ',&
+           &  sv%sweeps,' sweeps'
+    else
+      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  tolerance',&
+           &  sv%eps,' and maxit', sv%sweeps
+    end if
+    
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine z_l1_jac_solver_descr
+
+  function z_l1_jac_solver_get_fmt() result(val)
+    implicit none 
+    character(len=32)  :: val
+
+    val = "L1-Jacobi solver"
+  end function z_l1_jac_solver_get_fmt
+
+  function z_l1_jac_solver_get_id() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+
+    val = amg_l1_jac_
+  end function z_l1_jac_solver_get_id
+  
+end module amg_z_jac_solver

amgprec/amg_z_krm_solver.f90

@@ -436,7 +436,7 @@ contains
     val = "KRM solver"
   end function z_krm_solver_get_fmt
 
-  subroutine z_krm_solver_descr(sv,info,iout,coarse)
+  subroutine z_krm_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
@@ -444,12 +444,14 @@ contains
     class(amg_z_krm_solver_type), intent(in) :: sv
     integer(psb_ipk_), intent(out)             :: info
     integer(psb_ipk_), intent(in), optional    :: iout
-    logical, intent(in), optional       :: coarse
+    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_krm_solver_descr'
     integer(psb_ipk_) :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -458,23 +460,22 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
 
     if (sv%global) then
-      write(iout_,*) '  Krylov solver (global)'
+      write(iout_,*) trim(prefix_), '  Krylov solver (global)'
     else
-      write(iout_,*) '  Krylov solver (local) '
+      write(iout_,*) trim(prefix_), '  Krylov solver (local) '
     end if
-    write(iout_,*) '    method: ',sv%method
+    write(iout_,*) trim(prefix_), '    method: ',sv%method
-    write(iout_,*) '     kprec: ',sv%kprec
+    write(iout_,*) trim(prefix_), '     kprec: ',sv%kprec
-    if (sv%i_sub_solve > 0) then
+    call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
-      write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
+    write(iout_,*) trim(prefix_), '     itmax: ',sv%itmax
-    else
+    write(iout_,*) trim(prefix_), '       eps: ',sv%eps
-      write(iout_,*) ' sub_solve: ',sv%sub_solve
-    end if
-    write(iout_,*) '     itmax: ',sv%itmax
-    write(iout_,*) '       eps: ',sv%eps
-    write(iout_,*) '    fillin: ',sv%fillin
-
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_z_mumps_solver.F90

@@ -78,7 +78,8 @@ module amg_z_mumps_solver
     !
     ! Controls to be set before MUMPS instantiation:
     !
-    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: LOCAL   1==amg_global_solver_: GLOBAL
+    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: 'LOCAL_SOLVER
+    !                            1==amg_global_solver_: 'GLOBAL_SOLVER'
     ! IPAR(2) : MUMPS_PRINT_ERR  print verbosity (see MUMPS)
     ! IPAR(3) : MUMPS_SYM        0: non-symmetric   2: symmetric
     integer(psb_ipk_), dimension(3) :: ipar
@@ -313,22 +314,24 @@ subroutine z_mumps_solver_finalize(sv)
 
 end subroutine z_mumps_solver_finalize
 
-subroutine z_mumps_solver_descr(sv,info,iout,coarse)
+subroutine z_mumps_solver_descr(sv,info,iout,coarse,prefix)
 
   Implicit None
 
   ! Arguments
   class(amg_z_mumps_solver_type), intent(in) :: sv
-  integer(psb_ipk_), intent(out)                     :: info
+  integer(psb_ipk_), intent(out)               :: info
-  integer(psb_ipk_), intent(in), optional            :: iout
+  integer(psb_ipk_), intent(in), optional      :: iout
-  logical, intent(in), optional       :: coarse
+  logical, intent(in), optional                :: coarse
-
+  character(len=*), intent(in), optional       :: prefix
+      
   ! Local variables
   integer(psb_ipk_)   :: err_act
   type(psb_ctxt_type) :: ctxt
   integer(psb_ipk_)   :: me, np
   character(len=20), parameter :: name='amg_z_mumps_solver_descr'
   integer(psb_ipk_) :: iout_
+  character(1024)    :: prefix_
 
   call psb_erractionsave(err_act)
   info = psb_success_
@@ -337,8 +340,13 @@ subroutine z_mumps_solver_descr(sv,info,iout,coarse)
   else
     iout_ = psb_out_unit
   endif
+  if (present(prefix)) then
+    prefix_ = prefix
+  else
+    prefix_ = ""
+  end if
 
-  write(iout_,*) '  MUMPS  Solver. '
+  write(iout_,*) trim(prefix_), '  MUMPS  Solver. '
 
   call psb_erractionrestore(err_act)
   return

amgprec/amg_z_onelev_mod.f90

@@ -189,6 +189,7 @@ module amg_z_onelev_mod
     procedure, pass(lv) :: descr   => amg_z_base_onelev_descr
     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
@@ -257,7 +258,7 @@ module amg_z_onelev_mod
   end interface
 
   interface
-    subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
+    subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
       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
@@ -268,6 +269,7 @@ module amg_z_onelev_mod
       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
     end subroutine amg_z_base_onelev_descr
   end interface
 
@@ -284,7 +286,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, &
@@ -296,6 +298,18 @@ interface
     end subroutine amg_z_base_onelev_free
   end interface
 
+  interface
+    subroutine amg_z_base_onelev_free_smoothers(lv,info)
+      import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
+           & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
+           & psb_ipk_, psb_epk_, psb_desc_type
+      implicit none
+
+      class(amg_z_onelev_type), intent(inout) :: lv
+      integer(psb_ipk_), intent(out)                :: info
+    end subroutine amg_z_base_onelev_free_smoothers
+  end interface
+
   interface
     subroutine amg_z_base_onelev_check(lv,info)
       import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &

amgprec/amg_z_prec_type.f90

@@ -135,7 +135,9 @@ 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
   end type amg_zprec_type
 
@@ -155,15 +157,16 @@ module amg_z_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_zfile_prec_descr(prec,info,iout,root,verbosity)
+    subroutine amg_zfile_prec_descr(prec,info,iout,root,verbosity,prefix)
       import :: amg_zprec_type, psb_ipk_
       implicit none
       ! Arguments
-      class(amg_zprec_type), intent(in)      :: prec
+      class(amg_zprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out) :: info
+      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
     end subroutine amg_zfile_prec_descr
   end interface
 
@@ -344,6 +347,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
@@ -617,6 +628,68 @@ contains
 
   end subroutine amg_z_prec_free
 
+  subroutine amg_z_smoothers_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_zprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_z_smoothers_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    if (allocated(prec%precv)) then
+      do i=1,size(prec%precv)
+        call prec%precv(i)%free_smoothers(info)
+      end do
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_z_smoothers_free
+
+  subroutine amg_z_hierarchy_free(prec,info)
+
+    implicit none
+
+    ! Arguments
+    class(amg_zprec_type), intent(inout) :: prec
+    integer(psb_ipk_), intent(out)        :: info
+
+    ! Local variables
+    integer(psb_ipk_)   :: me,err_act,i
+    character(len=20)   :: name
+
+    info=psb_success_
+    name = 'amg_z_hierarchy_free'
+    call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
+
+    me=-1
+    write(0,*) 'Missing implementation '
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine amg_z_hierarchy_free
 
 
   !

amgprec/amg_z_slu_solver.F90

@@ -385,20 +385,22 @@ contains
   
   end subroutine z_slu_solver_finalize
 
-  subroutine z_slu_solver_descr(sv,info,iout,coarse)
+  subroutine z_slu_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_z_slu_solver_type), intent(in) :: sv
-    integer, intent(out)                     :: info
+    integer, intent(out)                       :: info
-    integer, intent(in), optional            :: iout
+    integer, intent(in), optional              :: iout
-    logical, intent(in), optional       :: coarse
+    logical, intent(in), optional              :: coarse
+    character(len=*), intent(in), optional     :: prefix
 
     ! Local variables
     integer      :: err_act
     character(len=20), parameter :: name='amg_z_slu_solver_descr'
     integer :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -407,8 +409,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
     
-    write(iout_,*) '  SuperLU Sparse Factorization Solver. '
+    write(iout_,*) trim(prefix_), '  SuperLU Sparse Factorization Solver. '
 
     call psb_erractionrestore(err_act)
     return

amgprec/amg_z_sludist_solver.F90

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

amgprec/amg_z_symdec_aggregator_mod.f90

@@ -88,16 +88,25 @@ contains
     val = "Symmetric Decoupled aggregation"
   end function amg_z_symdec_aggregator_fmt
   
-  subroutine  amg_z_symdec_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_z_symdec_aggregator_descr(ag,parms,iout,info,prefix)
     implicit none 
     class(amg_z_symdec_aggregator_type), intent(in) :: ag
     type(amg_dml_parms), intent(in)   :: parms
     integer(psb_ipk_), intent(in)  :: iout
     integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
 
-    write(iout,*) 'Decoupled Aggregator locally-symmetrized'
+    character(1024)    :: prefix_
-    write(iout,*) 'Aggregator object type: ',ag%fmt()
+
-    call parms%mldescr(iout,info)
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
+    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info,prefix=prefix)
     
     return
   end subroutine amg_z_symdec_aggregator_descr

amgprec/amg_z_umf_solver.F90

@@ -390,20 +390,22 @@ contains
   
   end subroutine z_umf_solver_finalize
 
-  subroutine z_umf_solver_descr(sv,info,iout,coarse)
+  subroutine z_umf_solver_descr(sv,info,iout,coarse,prefix)
 
     Implicit None
 
     ! Arguments
     class(amg_z_umf_solver_type), intent(in) :: sv
-    integer, intent(out)                     :: info
+    integer, intent(out)                       :: info
-    integer, intent(in), optional            :: iout
+    integer, intent(in), optional              :: iout
-    logical, intent(in), optional       :: coarse
+    logical, intent(in), optional              :: coarse
+      character(len=*), intent(in), optional   :: prefix
 
     ! Local variables
     integer      :: err_act
     character(len=20), parameter :: name='amg_z_umf_solver_descr'
     integer :: iout_
+    character(1024)    :: prefix_
 
     call psb_erractionsave(err_act)
     info = psb_success_
@@ -412,8 +414,13 @@ contains
     else
       iout_ = psb_out_unit
     endif
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
     
-    write(iout_,*) '  UMFPACK Sparse Factorization Solver. '
+    write(iout_,*) trim(prefix_), '  UMFPACK Sparse Factorization Solver. '
 
     call psb_erractionrestore(err_act)
     return

amgprec/impl/Makefile

@@ -67,22 +67,25 @@ OBJS=$(F90OBJS) $(COBJS) $(MPCOBJS)
 
 LIBNAME=libamg_prec.a
 
+objs: $(OBJS) aggrd levd smoothd solvd
+
 lib:  $(OBJS) aggrd levd smoothd solvd
+	cd aggregator && $(MAKE) lib
+	cd level && $(MAKE) lib
+	cd smoother && $(MAKE) lib
+	cd solver && $(MAKE) lib
 	$(AR) $(HERE)/$(LIBNAME) $(OBJS)
 	$(RANLIB) $(HERE)/$(LIBNAME)
 
 aggrd:
-	$(MAKE) -C aggregator
+	cd aggregator && $(MAKE) objs
 levd:
-	$(MAKE) -C level
+	cd level && $(MAKE)  objs
 smoothd:
-	$(MAKE) -C smoother
+	cd smoother   && $(MAKE)  objs
 solvd:
-	$(MAKE) -C solver
+	cd solver && $(MAKE)  objs
 
-mpobjs: 
-	(make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)")
-	(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
 
 veryclean: clean
 	/bin/rm -f $(LIBNAME)
@@ -91,10 +94,10 @@ clean: solvclean smoothclean levclean aggrclean
 	/bin/rm -f $(OBJS) $(LOCAL_MODS)
 
 aggrclean:
-		$(MAKE) -C aggregator clean
+	cd aggregator && $(MAKE) clean
 levclean:
-		$(MAKE) -C level clean
+	cd level && $(MAKE) clean
 smoothclean:
-		$(MAKE) -C smoother clean
+	cd smoother && 	$(MAKE)  clean
 solvclean:
-		$(MAKE) -C solver clean
+	cd solver && $(MAKE)  clean

amgprec/impl/aggregator/Makefile

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

amgprec/impl/aggregator/MatchBoxPC.cpp

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

amgprec/impl/aggregator/MatchBoxPC.h

@@ -52,145 +52,412 @@
 
 #ifndef _matchboxpC_H_
 #define _matchboxpC_H_
-//Turn on a lot of debugging information with this switch:
+// Turn on a lot of debugging information with this switch:
 //#define PRINT_DEBUG_INFO_
 #include <stdio.h>
 #include <iostream>
 #include <assert.h>
 #include <map>
 #include <vector>
-// #include "matchboxp.h"
+#include "omp.h"
 #include "primitiveDataTypeDefinitions.h"
 #include "dataStrStaticQueue.h"
 
 using namespace std;
 
+const int NUM_THREAD = 4;
+const int UCHUNK = 10;
+
+const MilanLongInt REQUEST = 1;
+const MilanLongInt SUCCESS = 2;
+const MilanLongInt FAILURE = 3;
+const MilanLongInt SIZEINFO = 4;
+
+const int ComputeTag = 7; // Predefined tag
+const int BundleTag = 9;  // Predefined tag
+
+static vector<MilanLongInt> DEFAULT_VECTOR;
+
+// MPI type map
+template <typename T>
+MPI_Datatype TypeMap();
+template <>
+inline MPI_Datatype TypeMap<int64_t>() { return MPI_LONG_LONG; }
+template <>
+inline MPI_Datatype TypeMap<int>() { return MPI_INT; }
+template <>
+inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
+template <>
+inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
+
 #ifdef __cplusplus
-extern "C" {
+extern "C"
+{
 #endif
 
 #if !defined(SERIAL_MPI)
-  
+
-#define MilanMpiLongInt  MPI_LONG_LONG
+#define MilanMpiLongInt MPI_LONG_LONG
 
 #ifndef _primitiveDataType_Definition_
 #define _primitiveDataType_Definition_
-    //Regular integer:
+// Regular integer:
-    #ifndef INTEGER_H
+#ifndef INTEGER_H
-    #define INTEGER_H
+#define INTEGER_H
-        typedef int32_t MilanInt;
+    typedef int32_t MilanInt;
-    #endif
+#endif
 
-    //Regular long integer:
+// Regular long integer:
-    #ifndef LONG_INT_H
+#ifndef LONG_INT_H
-    #define LONG_INT_H
+#define LONG_INT_H
-        #ifdef BIT64
+#ifdef BIT64
-            typedef int64_t MilanLongInt;
+    typedef int64_t MilanLongInt;
-            typedef MPI_LONG MilanMpiLongInt;
+    typedef MPI_LONG MilanMpiLongInt;
-        #else
+#else
-            typedef int32_t MilanLongInt;
+    typedef int32_t MilanLongInt;
-            typedef MPI_INT MilanMpiLongInt;
+    typedef MPI_INT MilanMpiLongInt;
-        #endif
+#endif
-    #endif
+#endif
 
-    //Regular boolean
+// Regular boolean
-    #ifndef BOOL_H
+#ifndef BOOL_H
-    #define BOOL_H
+#define BOOL_H
-        typedef bool MilanBool;
+    typedef bool MilanBool;
-    #endif
+#endif
 
-    //Regular double and absolute value computation:
+// Regular double and absolute value computation:
-    #ifndef REAL_H
+#ifndef REAL_H
-    #define REAL_H
+#define REAL_H
-        typedef double MilanReal;
+    typedef double MilanReal;
-        typedef MPI_DOUBLE MilanMpiReal;
+    typedef MPI_DOUBLE MilanMpiReal;
-        inline MilanReal MilanAbs(MilanReal value)
+    inline MilanReal MilanAbs(MilanReal value)
-        {
+    {
-            return fabs(value);
+        return fabs(value);
-        }
+    }
-    #endif
+#endif
 
-    //Regular float and absolute value computation:
+// Regular float and absolute value computation:
-    #ifndef FLOAT_H
+#ifndef FLOAT_H
-    #define FLOAT_H
+#define FLOAT_H
-        typedef float MilanFloat;
+    typedef float MilanFloat;
-        typedef MPI_FLOAT MilanMpiFloat;
+    typedef MPI_FLOAT MilanMpiFloat;
-        inline MilanFloat MilanAbsFloat(MilanFloat value)
+    inline MilanFloat MilanAbsFloat(MilanFloat value)
-        {
+    {
-            return fabs(value);
+        return fabs(value);
-        }
+    }
-    #endif
+#endif
 
-    //// Define the limits:
+//// Define the limits:
-    #ifndef LIMITS_H
+#ifndef LIMITS_H
-    #define LIMITS_H
+#define LIMITS_H
-    //Integer Maximum and Minimum:
+    // Integer Maximum and Minimum:
-  //      #define MilanIntMax INT_MAX
+    //      #define MilanIntMax INT_MAX
-  //    #define MilanIntMin INT_MIN
+    //    #define MilanIntMin INT_MIN
-        #define MilanIntMax INT32_MAX
+#define MilanIntMax INT32_MAX
-        #define MilanIntMin INT32_MIN
+#define MilanIntMin INT32_MIN
 
-        #ifdef BIT64
+#ifdef BIT64
-            #define MilanLongIntMax INT64_MAX
+#define MilanLongIntMax INT64_MAX
-            #define MilanLongIntMin -INT64_MAX
+#define MilanLongIntMin -INT64_MAX
-        #else
+#else
-            #define MilanLongIntMax INT32_MAX
+#define MilanLongIntMax INT32_MAX
-            #define MilanLongIntMin -INT32_MAX
+#define MilanLongIntMin -INT32_MAX
-        #endif
+#endif
 
-    #endif
+#endif
 
     // +INFINITY
     const double PLUS_INFINITY = numeric_limits<int>::infinity();
     const double MINUS_INFINITY = -PLUS_INFINITY;
-    //#define MilanRealMax LDBL_MAX
+//#define MilanRealMax LDBL_MAX
-    #define MilanRealMax PLUS_INFINITY
+#define MilanRealMax PLUS_INFINITY
-    #define MilanRealMin MINUS_INFINITY
+#define MilanRealMin MINUS_INFINITY
 #endif
 
-//Function of find the owner of a ghost vertex using binary search:
+    // Function of find the owner of a ghost vertex using binary search:
-inline MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
+    MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
-                                     MilanInt myRank, MilanInt numProcs);
+                              MilanInt myRank, MilanInt numProcs);
 
-  void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC
+    MilanLongInt firstComputeCandidateMate(MilanLongInt adj1,
-(
+                                           MilanLongInt adj2,
- MilanLongInt NLVer, MilanLongInt NLEdge,
+                                           MilanLongInt *verLocInd,
- MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight,
+                                           MilanReal *edgeLocWeight);
- MilanLongInt* verDistance,
- MilanLongInt* Mate,
- MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
- MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
- MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
- MilanLongInt* ph1_card, MilanLongInt* ph2_card );
 
- void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC
+    void queuesTransfer(vector<MilanLongInt> &U,
-(
+                        vector<MilanLongInt> &privateU,
-MilanLongInt NLVer, MilanLongInt NLEdge,
+                        vector<MilanLongInt> &QLocalVtx,
-MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight,
+                        vector<MilanLongInt> &QGhostVtx,
-MilanLongInt* verDistance,
+                        vector<MilanLongInt> &QMsgType,
-MilanLongInt* Mate,
+                        vector<MilanInt> &QOwner,
-MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
+                        vector<MilanLongInt> &privateQLocalVtx,
-MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
+                        vector<MilanLongInt> &privateQGhostVtx,
-MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
+                        vector<MilanLongInt> &privateQMsgType,
-MilanLongInt* ph1_card, MilanLongInt* ph2_card );
+                        vector<MilanInt> &privateQOwner);
 
-void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
+    bool isAlreadyMatched(MilanLongInt node,
-		MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight,
+                          MilanLongInt StartIndex,
-		MilanLongInt* verDistance,
+                          MilanLongInt EndIndex,
-		MilanLongInt* Mate,
+                          vector<MilanLongInt> &GMate,
-		MilanInt myRank, MilanInt numProcs, MilanInt icomm,
+                          MilanLongInt *Mate,
-		MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
+                          map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
-		MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
-		MilanLongInt* ph1_card, MilanLongInt* ph2_card );
 
-void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
+    MilanLongInt computeCandidateMate(MilanLongInt adj1,
-		MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight,
+                                      MilanLongInt adj2,
-		MilanLongInt* verDistance,
+                                      MilanReal *edgeLocWeight,
-		MilanLongInt* Mate,
+                                      MilanLongInt k,
-		MilanInt myRank, MilanInt numProcs, MilanInt icomm,
+                                      MilanLongInt *verLocInd,
-		MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
+                                      MilanLongInt StartIndex,
-		MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
+                                      MilanLongInt EndIndex,
-		MilanLongInt* ph1_card, MilanLongInt* ph2_card );
+                                      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_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,
+        MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
+        MilanLongInt *verDistance,
+        MilanLongInt *Mate,
+        MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
+        MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
+        MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
+        MilanLongInt *ph1_card, MilanLongInt *ph2_card);
+
+    void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
+        MilanLongInt NLVer, MilanLongInt NLEdge,
+        MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanFloat *edgeLocWeight,
+        MilanLongInt *verDistance,
+        MilanLongInt *Mate,
+        MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
+        MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
+        MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
+        MilanLongInt *ph1_card, MilanLongInt *ph2_card);
+
+    void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
+                     MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
+                     MilanLongInt *verDistance,
+                     MilanLongInt *Mate,
+                     MilanInt myRank, MilanInt numProcs, MilanInt icomm,
+                     MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
+                     MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
+                     MilanLongInt *ph1_card, MilanLongInt *ph2_card);
+
+    void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
+                     MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanFloat *edgeLocWeight,
+                     MilanLongInt *verDistance,
+                     MilanLongInt *Mate,
+                     MilanInt myRank, MilanInt numProcs, MilanInt icomm,
+                     MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
+                     MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
+                     MilanLongInt *ph1_card, MilanLongInt *ph2_card);
 
 #endif
 #ifdef __cplusplus

amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.cpp

@@ -72,12 +72,6 @@
 
 #ifdef SERIAL_MPI
 #else
-//MPI type map
-template<typename T> MPI_Datatype TypeMap();
-template<> inline MPI_Datatype TypeMap<int64_t>() { return MPI_LONG_LONG; }
-template<> inline MPI_Datatype TypeMap<int>() { return MPI_INT; }
-template<> inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
-template<> inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
 
 // DOUBLE PRECISION VERSION
 //WARNING: The vertex block on a given rank is contiguous