Do not print matching statistics

Make.inc.in

@@ -16,6 +16,7 @@ PSBLAS_LIBDIR=@PSBLAS_LIBDIR@
 @PSBLAS_INSTALL_MAKEINC@
 PSBLAS_INCLUDES=@PSBLAS_INCLUDES@
 PSBLAS_LIBS=@PSBLAS_LIBS@	
+PSBBASEMODNAME=psb_base_mod
 
 
 

Make_n.inc.in

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

Makefile

@@ -3,7 +3,7 @@ include Make.inc
 
 all:  library 
 
-library: libdir amgp
+library: libdir amgp cbnd
 #cbnd
 
 libdir:
@@ -33,8 +33,8 @@ install: all
 	mkdir -p  $(INSTALL_SAMPLESDIR) && \
 		 mkdir -p  $(INSTALL_SAMPLESDIR)/simple &&\
 	 	 mkdir -p  $(INSTALL_SAMPLESDIR)/advanced && \
-		(cd examples; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/simple ) && \
-		(cd tests; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/advanced )
+		(cd samples/simple; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/simple ) && \
+		(cd samples/advanced; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/advanced )
 cleanlib:
 	(cd lib; /bin/rm -f *.a *$(.mod) *$(.fh))
 	(cd include; /bin/rm -f *.a *$(.mod) *$(.fh))
@@ -42,13 +42,13 @@ cleanlib:
 
 veryclean: cleanlib
 	(cd amgprec; make veryclean)
-	(cd examples/fileread; make clean)
-	(cd examples/pdegen; make clean)
-	(cd tests/fileread; make clean)
-	(cd tests/pdegen; make clean)
+	(cd samples/simple/fileread; make clean)
+	(cd samples/simple/pdegen; make clean)
+	(cd samples/advanced/fileread; make clean)
+	(cd samples/advanced/pdegen; make clean)
 
 check: all
-	make check -C tests/pdegen
+	make check -C samples/advanced/pdegen
 
 clean:
 	(cd amgprec; make clean)

amgprec/Makefile

@@ -75,7 +75,7 @@ lib: $(OBJS) impld
 	/bin/cp -p *$(.mod) $(MODDIR)
 
 
-$(MODOBJS): $(PSBLAS_MODDIR)/$(BASEMODNAME)$(.mod)
+$(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
 
 amg_base_prec_type.o: amg_const.h
 amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o	: amg_base_prec_type.o

amgprec/amg_base_prec_type.F90

@@ -136,6 +136,8 @@ module amg_base_prec_type
     integer(psb_lpk_)                  :: target_coarse_size
     ! 2. maximum number of levels.   Defaults to  20
     integer(psb_ipk_)                  :: max_levs    = 20_psb_ipk_
+  contains
+    procedure, pass(ag) :: default => i_ag_default
   end type amg_iaggr_data
 
   type, extends(amg_iaggr_data) :: amg_saggr_data
@@ -143,6 +145,8 @@ module amg_base_prec_type
     real(psb_spk_)                     :: min_cr_ratio   = 1.5_psb_spk_
     real(psb_spk_)                     :: op_complexity  = szero
     real(psb_spk_)                     :: avg_cr         = szero
+  contains
+    procedure, pass(ag) ::   default => s_ag_default
   end type amg_saggr_data
 
   type, extends(amg_iaggr_data) :: amg_daggr_data
@@ -150,6 +154,8 @@ module amg_base_prec_type
     real(psb_dpk_)                     :: min_cr_ratio   = 1.5_psb_dpk_
     real(psb_dpk_)                     :: op_complexity  = dzero
     real(psb_dpk_)                     :: avg_cr         = dzero
+  contains
+    procedure, pass(ag) ::   default => d_ag_default
   end type amg_daggr_data
 
 
@@ -1240,4 +1246,31 @@ contains
          & (parms1%aggr_thresh      == parms2%aggr_thresh     )
   end function amg_d_equal_aggregation
 
+  subroutine i_ag_default(ag)
+    class(amg_iaggr_data), intent(inout) :: ag
+
+    ag%min_coarse_size = -ione
+    ag%min_coarse_size_per_process = -ione
+    ag%max_levs    = 20_psb_ipk_
+  end subroutine i_ag_default
+
+  subroutine s_ag_default(ag)
+    class(amg_saggr_data), intent(inout) :: ag
+
+    call ag%amg_iaggr_data%default()
+    ag%min_cr_ratio   = 1.5_psb_spk_
+    ag%op_complexity  = szero
+    ag%avg_cr         = szero
+  end subroutine s_ag_default
+
+  subroutine d_ag_default(ag)
+    class(amg_daggr_data), intent(inout) :: ag
+
+    call ag%amg_iaggr_data%default()
+    ag%min_cr_ratio   = 1.5_psb_dpk_
+    ag%op_complexity  = dzero
+    ag%avg_cr         = dzero
+  end subroutine d_ag_default
+
+
 end module amg_base_prec_type

amgprec/amg_c_base_aggregator_mod.f90

@@ -126,7 +126,7 @@ module amg_c_base_aggregator_mod
            & psb_c_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_c_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(in)            :: desc_a
+      type(psb_desc_type), intent(inout)         :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_sml_parms), intent(inout)         :: parms 
       type(psb_c_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -144,7 +144,7 @@ module amg_c_base_aggregator_mod
            & psb_c_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_c_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(in)            :: desc_a
+      type(psb_desc_type), intent(inout)         :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_sml_parms), intent(inout)         :: parms 
       type(psb_c_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr

amgprec/amg_c_prec_type.f90

@@ -155,11 +155,12 @@ module amg_c_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_cfile_prec_descr(prec,iout,root,verbosity)
+    subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity)
       import :: amg_cprec_type, psb_ipk_
       implicit none
       ! Arguments
       class(amg_cprec_type), intent(in)      :: prec
+      integer(psb_ipk_), intent(out) :: info
       integer(psb_ipk_), intent(in), optional :: iout
       integer(psb_ipk_), intent(in), optional :: root
       integer(psb_ipk_), intent(in), optional :: verbosity

amgprec/amg_d_base_aggregator_mod.f90

@@ -126,7 +126,7 @@ module amg_d_base_aggregator_mod
            & psb_d_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(in)            :: desc_a
+      type(psb_desc_type), intent(inout)         :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_dml_parms), intent(inout)         :: parms 
       type(psb_d_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -144,7 +144,7 @@ module amg_d_base_aggregator_mod
            & psb_d_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(in)            :: desc_a
+      type(psb_desc_type), intent(inout)         :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_dml_parms), intent(inout)         :: parms 
       type(psb_d_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr

amgprec/amg_d_matchboxp_mod.f90

@@ -118,6 +118,7 @@ module dmatchboxp_mod
     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,&
@@ -421,11 +422,13 @@ contains
         nlpairs    = v(3)
 
       end block
-      if (iam == 0) then
-        write(0,*) 'Matching statistics: Unmatched nodes ',&
-             & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
+      if (print_statistics) then
+        if (iam == 0) then
+          write(0,*) 'Matching statistics: Unmatched nodes ',&
+               & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
+        end if
       end if
-
+      
       if (display_out_) then
         block
           integer(psb_ipk_) :: idx

amgprec/amg_d_parmatch_aggregator_mod.F90

@@ -119,7 +119,10 @@
 module amg_d_parmatch_aggregator_mod
   use amg_d_base_aggregator_mod
   use dmatchboxp_mod
-
+#if defined(SERIAL_MPI)
+  type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
+  end type amg_d_parmatch_aggregator_type
+#else 
   type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
     integer(psb_ipk_) :: matching_alg
     integer(psb_ipk_) :: n_sweeps   ! When n_sweeps >1 we need an auxiliary descriptor
@@ -165,7 +168,7 @@ module amg_d_parmatch_aggregator_mod
       type(amg_dml_parms), intent(inout)   :: parms
       type(amg_daggr_data), intent(in)     :: ag_data
       type(psb_dspmat_type), intent(inout) :: a
-      type(psb_desc_type), intent(inout)   :: desc_a
+      type(psb_desc_type), intent(inout)     :: desc_a
       integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
       type(psb_ldspmat_type), intent(out)  :: t_prol
       integer(psb_ipk_), intent(out)      :: info
@@ -232,7 +235,7 @@ module amg_d_parmatch_aggregator_mod
            & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
       implicit none
       type(psb_dspmat_type), intent(in)       :: a
-      type(psb_desc_type), intent(in)         :: desc_a
+      type(psb_desc_type), intent(inout)       :: desc_a
       integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
       type(amg_dml_parms), intent(inout)      :: parms
       type(psb_ldspmat_type), intent(inout)   :: t_prol
@@ -254,7 +257,7 @@ module amg_d_parmatch_aggregator_mod
       integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
       type(amg_dml_parms), intent(inout)      :: parms
       type(psb_ldspmat_type), intent(inout)   :: t_prol
-      type(psb_dspmat_type), intent(out)      :: op_prol,ac, op_restr
+      type(psb_dspmat_type), intent(inout)      :: op_prol,ac, op_restr
       type(psb_desc_type), intent(inout)    :: desc_ac
       integer(psb_ipk_), intent(out)          :: info
     end subroutine amg_d_parmatch_unsmth_bld
@@ -272,7 +275,7 @@ module amg_d_parmatch_aggregator_mod
       integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
       type(amg_dml_parms), intent(inout)      :: parms
       type(psb_ldspmat_type), intent(inout)   :: t_prol
-      type(psb_dspmat_type), intent(out)      :: op_prol,ac, op_restr
+      type(psb_dspmat_type), intent(inout)    :: op_prol,ac, op_restr
       type(psb_desc_type), intent(inout)    :: desc_ac
       integer(psb_ipk_), intent(out)          :: info
     end subroutine amg_d_parmatch_smth_bld
@@ -285,11 +288,11 @@ module amg_d_parmatch_aggregator_mod
            & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
       implicit none
       type(psb_dspmat_type), intent(inout)    :: a
-      type(psb_desc_type), intent(in)         :: desc_a
+      type(psb_desc_type), intent(inout)       :: desc_a
       integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
       type(amg_dml_parms), intent(inout)      :: parms
       type(psb_ldspmat_type), intent(inout)   :: t_prol
-      type(psb_dspmat_type), intent(out)      :: op_prol,ac, op_restr
+      type(psb_dspmat_type), intent(inout)    :: op_prol,ac, op_restr
       type(psb_desc_type), intent(out)          :: desc_ac
       integer(psb_ipk_), intent(out)          :: info
     end subroutine amg_d_parmatch_spmm_bld_ov
@@ -303,11 +306,11 @@ module amg_d_parmatch_aggregator_mod
            & psb_d_csr_sparse_mat, psb_ld_csr_sparse_mat
       implicit none
       type(psb_d_csr_sparse_mat), intent(inout) :: a
-      type(psb_desc_type), intent(in)           :: desc_a
+      type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)          :: ilaggr(:), nlaggr(:)
       type(amg_dml_parms), intent(inout)        :: parms
       type(psb_ldspmat_type), intent(inout)     :: t_prol
-      type(psb_dspmat_type), intent(out)        :: op_prol,ac, op_restr
+      type(psb_dspmat_type), intent(inout)      :: op_prol,ac, op_restr
       type(psb_desc_type), intent(out)          :: desc_ac
       integer(psb_ipk_), intent(out)            :: info
     end subroutine amg_d_parmatch_spmm_bld_inner
@@ -681,5 +684,5 @@ contains
 
     return
   end subroutine amg_d_parmatch_aggregator_bld_map
-
+#endif
 end module amg_d_parmatch_aggregator_mod

amgprec/amg_d_prec_type.f90

@@ -155,11 +155,12 @@ module amg_d_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_dfile_prec_descr(prec,iout,root,verbosity)
+    subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity)
       import :: amg_dprec_type, psb_ipk_
       implicit none
       ! Arguments
       class(amg_dprec_type), intent(in)      :: prec
+      integer(psb_ipk_), intent(out) :: info
       integer(psb_ipk_), intent(in), optional :: iout
       integer(psb_ipk_), intent(in), optional :: root
       integer(psb_ipk_), intent(in), optional :: verbosity

amgprec/amg_s_base_aggregator_mod.f90

@@ -126,7 +126,7 @@ module amg_s_base_aggregator_mod
            & psb_s_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_s_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(in)            :: desc_a
+      type(psb_desc_type), intent(inout)         :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_sml_parms), intent(inout)         :: parms 
       type(psb_s_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -144,7 +144,7 @@ module amg_s_base_aggregator_mod
            & psb_s_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_s_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(in)            :: desc_a
+      type(psb_desc_type), intent(inout)         :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_sml_parms), intent(inout)         :: parms 
       type(psb_s_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr

amgprec/amg_s_matchboxp_mod.f90

@@ -118,6 +118,7 @@ module smatchboxp_mod
     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,&
@@ -421,11 +422,13 @@ contains
         nlpairs    = v(3)
 
       end block
-      if (iam == 0) then
-        write(0,*) 'Matching statistics: Unmatched nodes ',&
-             & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
+      if (print_statistics) then
+        if (iam == 0) then
+          write(0,*) 'Matching statistics: Unmatched nodes ',&
+               & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
+        end if
       end if
-
+      
       if (display_out_) then
         block
           integer(psb_ipk_) :: idx

amgprec/amg_s_parmatch_aggregator_mod.F90

@@ -119,7 +119,10 @@
 module amg_s_parmatch_aggregator_mod
   use amg_s_base_aggregator_mod
   use smatchboxp_mod
-
+#if defined(SERIAL_MPI)
+  type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
+  end type amg_s_parmatch_aggregator_type
+#else 
   type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
     integer(psb_ipk_) :: matching_alg
     integer(psb_ipk_) :: n_sweeps   ! When n_sweeps >1 we need an auxiliary descriptor
@@ -165,7 +168,7 @@ module amg_s_parmatch_aggregator_mod
       type(amg_sml_parms), intent(inout)   :: parms
       type(amg_saggr_data), intent(in)     :: ag_data
       type(psb_sspmat_type), intent(inout) :: a
-      type(psb_desc_type), intent(inout)   :: desc_a
+      type(psb_desc_type), intent(inout)     :: desc_a
       integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
       type(psb_lsspmat_type), intent(out)  :: t_prol
       integer(psb_ipk_), intent(out)      :: info
@@ -232,7 +235,7 @@ module amg_s_parmatch_aggregator_mod
            & psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
       implicit none
       type(psb_sspmat_type), intent(in)       :: a
-      type(psb_desc_type), intent(in)         :: desc_a
+      type(psb_desc_type), intent(inout)       :: desc_a
       integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
       type(amg_sml_parms), intent(inout)      :: parms
       type(psb_lsspmat_type), intent(inout)   :: t_prol
@@ -254,7 +257,7 @@ module amg_s_parmatch_aggregator_mod
       integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
       type(amg_sml_parms), intent(inout)      :: parms
       type(psb_lsspmat_type), intent(inout)   :: t_prol
-      type(psb_sspmat_type), intent(out)      :: op_prol,ac, op_restr
+      type(psb_sspmat_type), intent(inout)      :: op_prol,ac, op_restr
       type(psb_desc_type), intent(inout)    :: desc_ac
       integer(psb_ipk_), intent(out)          :: info
     end subroutine amg_s_parmatch_unsmth_bld
@@ -272,7 +275,7 @@ module amg_s_parmatch_aggregator_mod
       integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
       type(amg_sml_parms), intent(inout)      :: parms
       type(psb_lsspmat_type), intent(inout)   :: t_prol
-      type(psb_sspmat_type), intent(out)      :: op_prol,ac, op_restr
+      type(psb_sspmat_type), intent(inout)    :: op_prol,ac, op_restr
       type(psb_desc_type), intent(inout)    :: desc_ac
       integer(psb_ipk_), intent(out)          :: info
     end subroutine amg_s_parmatch_smth_bld
@@ -285,11 +288,11 @@ module amg_s_parmatch_aggregator_mod
            & psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
       implicit none
       type(psb_sspmat_type), intent(inout)    :: a
-      type(psb_desc_type), intent(in)         :: desc_a
+      type(psb_desc_type), intent(inout)       :: desc_a
       integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
       type(amg_sml_parms), intent(inout)      :: parms
       type(psb_lsspmat_type), intent(inout)   :: t_prol
-      type(psb_sspmat_type), intent(out)      :: op_prol,ac, op_restr
+      type(psb_sspmat_type), intent(inout)    :: op_prol,ac, op_restr
       type(psb_desc_type), intent(out)          :: desc_ac
       integer(psb_ipk_), intent(out)          :: info
     end subroutine amg_s_parmatch_spmm_bld_ov
@@ -303,11 +306,11 @@ module amg_s_parmatch_aggregator_mod
            & psb_s_csr_sparse_mat, psb_ls_csr_sparse_mat
       implicit none
       type(psb_s_csr_sparse_mat), intent(inout) :: a
-      type(psb_desc_type), intent(in)           :: desc_a
+      type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)          :: ilaggr(:), nlaggr(:)
       type(amg_sml_parms), intent(inout)        :: parms
       type(psb_lsspmat_type), intent(inout)     :: t_prol
-      type(psb_sspmat_type), intent(out)        :: op_prol,ac, op_restr
+      type(psb_sspmat_type), intent(inout)      :: op_prol,ac, op_restr
       type(psb_desc_type), intent(out)          :: desc_ac
       integer(psb_ipk_), intent(out)            :: info
     end subroutine amg_s_parmatch_spmm_bld_inner
@@ -681,5 +684,5 @@ contains
 
     return
   end subroutine amg_s_parmatch_aggregator_bld_map
-
+#endif
 end module amg_s_parmatch_aggregator_mod

amgprec/amg_s_prec_type.f90

@@ -155,11 +155,12 @@ module amg_s_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_sfile_prec_descr(prec,iout,root,verbosity)
+    subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity)
       import :: amg_sprec_type, psb_ipk_
       implicit none
       ! Arguments
       class(amg_sprec_type), intent(in)      :: prec
+      integer(psb_ipk_), intent(out) :: info
       integer(psb_ipk_), intent(in), optional :: iout
       integer(psb_ipk_), intent(in), optional :: root
       integer(psb_ipk_), intent(in), optional :: verbosity

amgprec/amg_z_base_aggregator_mod.f90

@@ -126,7 +126,7 @@ module amg_z_base_aggregator_mod
            & psb_z_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_z_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(in)            :: desc_a
+      type(psb_desc_type), intent(inout)         :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_dml_parms), intent(inout)         :: parms 
       type(psb_z_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -144,7 +144,7 @@ module amg_z_base_aggregator_mod
            & psb_z_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
       implicit none
       type(psb_z_csr_sparse_mat), intent(inout) :: a_csr
-      type(psb_desc_type), intent(in)            :: desc_a
+      type(psb_desc_type), intent(inout)         :: desc_a
       integer(psb_lpk_), intent(inout)           :: nlaggr(:)
       type(amg_dml_parms), intent(inout)         :: parms 
       type(psb_z_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr

amgprec/amg_z_prec_type.f90

@@ -155,11 +155,12 @@ module amg_z_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_zfile_prec_descr(prec,iout,root,verbosity)
+    subroutine amg_zfile_prec_descr(prec,info,iout,root,verbosity)
       import :: amg_zprec_type, psb_ipk_
       implicit none
       ! Arguments
       class(amg_zprec_type), intent(in)      :: prec
+      integer(psb_ipk_), intent(out) :: info
       integer(psb_ipk_), intent(in), optional :: iout
       integer(psb_ipk_), intent(in), optional :: root
       integer(psb_ipk_), intent(in), optional :: verbosity

amgprec/impl/aggregator/MatchBoxPC.cpp

@@ -40,7 +40,9 @@
 // ************************************************************************
 #include <stdio.h>
 #include <stdlib.h>
+#if !defined(SERIAL_MPI)
 #include <mpi.h>
+#endif
 
 #include "MatchBoxPC.h"
 #ifdef __cplusplus
@@ -56,6 +58,7 @@ void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
 		MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
 		MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
 		MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
+#if !defined(SERIAL_MPI)
   MPI_Comm C_comm=MPI_Comm_f2c(icomm);
 #ifdef DEBUG
   fprintf(stderr,"MatchBoxPC: rank %d nlver %ld nledge %ld [ %ld %ld ]\n",
@@ -68,6 +71,7 @@ void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
 							   msgIndSent, msgActualSent, msgPercent,
 							   ph0_time, ph1_time, ph2_time,
 							   ph1_card, ph2_card );
+#endif
 }
 
 void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
@@ -78,6 +82,7 @@ void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
 		MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
 		MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
 		MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
+#if !defined(SERIAL_MPI)
   MPI_Comm C_comm=MPI_Comm_f2c(icomm);
 #ifdef DEBUG
   fprintf(stderr,"MatchBoxPC: rank %d nlver %ld nledge %ld [ %ld %ld ]\n",
@@ -90,6 +95,7 @@ void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
 							   msgIndSent, msgActualSent, msgPercent,
 							   ph0_time, ph1_time, ph2_time,
 							   ph1_card, ph2_card );
+#endif
 }
 
 #ifdef __cplusplus

amgprec/impl/aggregator/MatchBoxPC.h

@@ -69,6 +69,8 @@ using namespace std;
 extern "C" {
 #endif
 
+#if !defined(SERIAL_MPI)
+  
 #define MilanMpiLongInt  MPI_LONG_LONG
 
 #ifndef _primitiveDataType_Definition_
@@ -190,6 +192,7 @@ void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
 		MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
 		MilanLongInt* ph1_card, MilanLongInt* ph2_card );
 
+#endif
 #ifdef __cplusplus
 }
 #endif

amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.cpp

@@ -70,6 +70,8 @@
  Statistics: ph1_card, ph2_card : Size: |P| number of processes in the comm-world (number of matched edges in Phase 1 and Phase 2)
  */
 
+#ifdef SERIAL_MPI
+#else
 //MPI type map
 template<typename T> MPI_Datatype TypeMap();
 template<> inline MPI_Datatype TypeMap<int64_t>() { return MPI_LONG_LONG; }
@@ -90,6 +92,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
 							      MilanReal* msgPercent,
                                                               MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
                                                               MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
+#if !defined(SERIAL_MPI)
 #ifdef PRINT_DEBUG_INFO_
     cout<<"\n("<<myRank<<")Within algoEdgeApproxDominatingEdgesLinearSearchMessageBundling()"; fflush(stdout);
 #endif
@@ -110,7 +113,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
     const int ComputeTag = 7;  //Predefined tag
     const int BundleTag = 9;   //Predefined tag
     int error_codeC;
-    error_codeC = MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
+    error_codeC = MPI_Comm_set_errhandler(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
     char error_message[MPI_MAX_ERROR_STRING];
     int message_length;
 
@@ -1300,7 +1303,8 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
     if (myRank == 0) cout<<"\n("<<myRank<<") Done" <<endl; fflush(stdout);
 #endif
     //MPI_Barrier(comm);
-} //End of algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMate
+}
+//End of algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMate
 
 // SINGLE PRECISION VERSION
 
@@ -1315,6 +1319,7 @@ void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
 							      MilanReal* msgPercent,
                                                               MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
                                                               MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
+#if !defined(SERIAL_MPI)
 #ifdef PRINT_DEBUG_INFO_
     cout<<"\n("<<myRank<<")Within algoEdgeApproxDominatingEdgesLinearSearchMessageBundling()"; fflush(stdout);
 #endif
@@ -1335,7 +1340,7 @@ void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
     const int ComputeTag = 7;  //Predefined tag
     const int BundleTag = 9;   //Predefined tag
     int error_codeC;
-    error_codeC = MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
+    error_codeC = MPI_Comm_set_errhandler(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
     char error_message[MPI_MAX_ERROR_STRING];
     int message_length;
 
@@ -2525,8 +2530,9 @@ void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
     if (myRank == 0) cout<<"\n("<<myRank<<") Done" <<endl; fflush(stdout);
 #endif
     //MPI_Barrier(comm);
+#endif
 } //End of algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMate
-
+#endif
 
 ///Find the owner of a ghost node:
 inline MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
@@ -2572,3 +2578,4 @@ inline MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistan
   } //End of else
   return (-1); //It should not reach here!
 } //End of findOwnerOfGhost()
+#endif

amgprec/impl/aggregator/amg_c_dec_aggregator_tprol.f90

@@ -83,8 +83,8 @@ subroutine  amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
   class(amg_c_dec_aggregator_type), target, intent(inout) :: ag
   type(amg_sml_parms), intent(inout)  :: parms
   type(amg_saggr_data), intent(in)    :: ag_data
-  type(psb_cspmat_type), intent(in)   :: a
-  type(psb_desc_type), intent(in)     :: desc_a
+  type(psb_cspmat_type), intent(inout) :: a
+  type(psb_desc_type), intent(inout)    :: desc_a
   integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
   type(psb_lcspmat_type), intent(out)  :: t_prol
   integer(psb_ipk_), intent(out)      :: info

amgprec/impl/aggregator/amg_c_symdec_aggregator_tprol.f90

@@ -86,8 +86,8 @@ subroutine  amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
   class(amg_c_symdec_aggregator_type), target, intent(inout) :: ag
   type(amg_sml_parms), intent(inout)  :: parms
   type(amg_saggr_data), intent(in)    :: ag_data
-  type(psb_cspmat_type), intent(in)   :: a
-  type(psb_desc_type), intent(in)     :: desc_a
+  type(psb_cspmat_type), intent(inout) :: a
+  type(psb_desc_type), intent(inout)   :: desc_a
   integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
   type(psb_lcspmat_type), intent(out)  :: op_prol
   integer(psb_ipk_), intent(out)      :: info

amgprec/impl/aggregator/amg_caggrmat_minnrg_bld.f90

@@ -105,7 +105,7 @@
 !
 !
 subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,info)
+     & ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_c_inner_mod, amg_protect_name => amg_caggrmat_minnrg_bld
@@ -117,8 +117,8 @@ subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
   type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
   type(amg_sml_parms), intent(inout)         :: parms 
-  type(psb_lcspmat_type), intent(inout)       :: op_prol
-  type(psb_lcspmat_type), intent(out)         :: ac,op_restr
+  type(psb_lcspmat_type), intent(inout)       :: t_prol
+  type(psb_cspmat_type), intent(inout)       :: op_prol, ac,op_restr
   type(psb_desc_type), intent(inout)            :: desc_ac
   integer(psb_ipk_), intent(out)                :: info
 
@@ -171,6 +171,8 @@ subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   filter_mat = (parms%aggr_filter == amg_filter_mat_)
 
+  !NEEDS TO BE REWORKED !!
+  
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
@@ -183,361 +185,361 @@ subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
     goto 9999      
   end if
 
-  ! Get the diagonal D
-  adiag =  a%get_diag(info)
-  if (info == psb_success_) &
-       & call psb_realloc(ncol,adiag,info)    
-  if (info == psb_success_) &
-       & call psb_halo(adiag,desc_a,info)
-  if (info == psb_success_) call a%cp_to_l(la)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
-    goto 9999
-  end if
-
-  do i=1,size(adiag)
-    if (adiag(i) /= czero) then
-      adinv(i) = cone / adiag(i)
-    else
-      adinv(i) = cone
-    end if
-  end do
-
-
-
-  ! 1. Allocate Ptilde in sparse matrix form 
-  call op_prol%mv_to(tmpcoo)
-  call ptilde%mv_from(tmpcoo)
-  call ptilde%cscnv(info,type='csr')
-
-  if (info == psb_success_) call la%cscnv(am3,info,type='csr',dupl=psb_dupl_add_)
-  if (info == psb_success_) call la%cscnv(da,info,type='csr',dupl=psb_dupl_add_)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
-    goto 9999
-  end if
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & ' Initial copies done.'
-
-  call da%scal(adinv,info)
-
-  call psb_spspmm(da,ptilde,dap,info)
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
-    goto 9999
-  end if
-
-  call dap%clone(atmp,info)
-
-  call psb_sphalo(atmp,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
-  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-  call psb_spspmm(da,atmp,dadap,info)
-  call atmp%free()
-
-  !  !$  write(0,*) 'Columns of AP',psb_sp_get_ncols(ap)
-  !  !$  write(0,*) 'Columns of ADAP',psb_sp_get_ncols(adap)
-  call dap%mv_to(csc_dap)
-  call dadap%mv_to(csc_dadap)
-
-  call csc_mat_col_prod(csc_dap,csc_dadap,omp,info)
-  call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info)
-  call psb_sum(ctxt,omp)
-  call psb_sum(ctxt,oden)
-  ! !$  write(0,*) trim(name),' OMP :',omp
-  ! !$  write(0,*) trim(name),' ODEN:',oden
-
-  omp = omp/oden
-
-  ! !$  write(0,*) 'Check on output prolongator ',omp(1:min(size(omp),10))
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done NUMBMM 1'
-
-  call am3%mv_to(acsr3)
-  ! Compute omega_int
-  ommx = czero
-  do i=1, ncol
-    if (ilaggr(i) >0) then 
-      omi(i) = omp(ilaggr(i))
-    else
-      omi(i) = czero
-    end if
-    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
-  end do
-  ! Compute omega_fine
-  do i=1, nrow
-    omf(i) = ommx
-    do j=acsr3%irp(i),acsr3%irp(i+1)-1
-      if(abs(omi(acsr3%ja(j))) .lt. abs(omf(i))) omf(i)=omi(acsr3%ja(j))
-    end do
-!!$    if(min(real(omf(i)),aimag(omf(i))) < szero) omf(i) = czero
-    if(psb_minreal(omf(i)) < szero) omf(i) = czero
-  end do
-
-  omf(1:nrow) = omf(1:nrow) * adinv(1:nrow)
-
-  if (filter_mat) then
-    !
-    ! Build the filtered matrix Af from A
-    ! 
-    call la%cscnv(acsrf,info,dupl=psb_dupl_add_)
-
-    do i=1,nrow
-      tmp = czero
-      jd  = -1 
-      do j=acsrf%irp(i),acsrf%irp(i+1)-1
-        if (acsrf%ja(j) == i) jd = j 
-        if (abs(acsrf%val(j)) < theta*sqrt(abs(adiag(i)*adiag(acsrf%ja(j))))) then
-          tmp=tmp+acsrf%val(j)
-          acsrf%val(j)=czero
-        endif
-      enddo
-      if (jd == -1) then 
-        write(0,*) 'Wrong input: we need the diagonal!!!!', i
-      else
-        acsrf%val(jd)=acsrf%val(jd)-tmp
-      end if
-    enddo
-    ! Take out zeroed terms 
-    call acsrf%clean_zeros(info)
-
-    !
-    ! Build the smoothed prolongator using the filtered matrix
-    ! 
-    do i=1,acsrf%get_nrows()
-      do j=acsrf%irp(i),acsrf%irp(i+1)-1
-        if (acsrf%ja(j) == i) then 
-          acsrf%val(j) = cone - omf(i)*acsrf%val(j) 
-        else
-          acsrf%val(j) = - omf(i)*acsrf%val(j) 
-        end if
-      end do
-    end do
-
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done gather, going for SYMBMM 1'
-
-    call af%mv_from(acsrf)
-    !
-    ! op_prol = (I-w*D*Af)Ptilde
-    ! Doing it this way means to consider diag(Af_i)
-    ! 
-    !
-    call psb_spspmm(af,ptilde,op_prol,info)
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done SPSPMM 1'
-  else
-    !
-    ! Build the smoothed prolongator using the original matrix
-    !
-    do i=1,acsr3%get_nrows()
-      do j=acsr3%irp(i),acsr3%irp(i+1)-1
-        if (acsr3%ja(j) == i) then 
-          acsr3%val(j) = cone - omf(i)*acsr3%val(j) 
-        else
-          acsr3%val(j) = - omf(i)*acsr3%val(j) 
-        end if
-      end do
-    end do
-
-    call am3%mv_from(acsr3)
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done gather, going for SYMBMM 1'
-    !
-    ! 
-    ! op_prol = (I-w*D*A)Ptilde
-    ! 
-    !
-    call psb_spspmm(am3,ptilde,op_prol,info)
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done NUMBMM 1'
-
-  end if
-
-
-  !
-  ! Ok, let's start over with the restrictor
-  ! 
-  call ptilde%transc(rtilde)
-  call la%cscnv(atmp,info,type='csr')
-  call psb_sphalo(atmp,desc_a,am4,info,&
-       & colcnv=.true.,rowscale=.true.)
-  nrt  = am4%get_nrows() 
-  call am4%csclip(atmp2,info,lone,nrt,lone,ncol)
-  call atmp2%cscnv(info,type='CSR')
-  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=atmp2)      
-  call am4%free()
-  call atmp2%free()
-
-  ! This is to compute the transpose. It ONLY works if the
-  ! original A has a symmetric pattern.
-  call atmp%transc(atmp2) 
-  call atmp2%csclip(dat,info,lone,nrow,lone,ncol)
-  call dat%cscnv(info,type='csr')
-  call dat%scal(adinv,info)
-
-  ! Now for the product. 
-  call psb_spspmm(dat,ptilde,datp,info)
-
-  call datp%clone(atmp2,info)
-  call psb_sphalo(atmp2,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
-  if (info == psb_success_) call psb_rwextd(ncol,atmp2,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-
-  call psb_symbmm(dat,atmp2,datdatp,info)
-  call psb_numbmm(dat,atmp2,datdatp)
-  call atmp2%free()
-
-  call datp%mv_to(csc_datp)    
-  call datdatp%mv_to(csc_datdatp)    
-
-  call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info)
-  call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info)
-  call psb_sum(ctxt,omp)
-  call psb_sum(ctxt,oden)
-
-
-  ! !$  write(debug_unit,*) trim(name),' OMP_R :',omp
-  ! ! $  write(debug_unit,*) trim(name),' ODEN_R:',oden
-  omp = omp/oden
-  ! !$  write(0,*) 'Check on output restrictor',omp(1:min(size(omp),10))
-  ! Compute omega_int
-  ommx = czero
-  do i=1, ncol
-    if (ilaggr(i) >0) then 
-      omi(i) = omp(ilaggr(i))
-    else
-      omi(i) = czero
-    end if
-    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
-  end do
-  ! Compute omega_fine
-  ! Going over the columns of atmp means going over the rows
-  ! of A^T. Hopefully ;-) 
-  call atmp%cp_to(acsc)
-
-  do i=1, nrow
-    omf(i) = ommx
-    do j= acsc%icp(i),acsc%icp(i+1)-1
-      if(abs(omi(acsc%ia(j))) .lt. abs(omf(i))) omf(i)=omi(acsc%ia(j))
-    end do
-!!$    if(min(real(omf(i)),aimag(omf(i))) < szero) omf(i) = czero
-    if(psb_minreal(omf(i)) < szero) omf(i) = czero
-  end do
-  omf(1:nrow) = omf(1:nrow)*adinv(1:nrow)
-  call psb_halo(omf,desc_a,info)
-  call acsc%free() 
-
-
-  call atmp%mv_to(acsr1)
-
-  do i=1,acsr1%get_nrows()
-    do j=acsr1%irp(i),acsr1%irp(i+1)-1
-      if (acsr1%ja(j) == i) then 
-        acsr1%val(j) = cone - acsr1%val(j)*omf(acsr1%ja(j))
-      else
-        acsr1%val(j) =      - acsr1%val(j)*omf(acsr1%ja(j))
-      end if
-    end do
-  end do
-  call atmp%mv_from(acsr1)
-
-  call rtilde%mv_to(tmpcoo)
-  nzl = tmpcoo%get_nzeros()
-  i=0
-  do k=1, nzl
-    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
-      i = i+1
-      tmpcoo%val(i) = tmpcoo%val(k)
-      tmpcoo%ia(i)  = tmpcoo%ia(k)
-      tmpcoo%ja(i)  = tmpcoo%ja(k)
-    end if
-  end do
-  call tmpcoo%set_nzeros(i)
-  call rtilde%mv_from(tmpcoo)
-  call rtilde%cscnv(info,type='csr')
-
-  call psb_spspmm(rtilde,atmp,op_restr,info)
-
-  !
-  ! Now we have to gather the halo of op_prol, and add it to itself
-  ! to multiply it by A,
-  !
-  call op_prol%clone(tmp_prol,info) 
-  if (info == psb_success_) call psb_sphalo(tmp_prol,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.)
-  if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol')
-    goto 9999
-  end if
-
-  !
-  ! Now we have to fix this.  The only rows of B that are correct 
-  ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
-  !
-  call op_restr%mv_to(tmpcoo)
-
-  nzl = tmpcoo%get_nzeros()
-  i=0
-  do k=1, nzl
-    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
-      i = i+1
-      tmpcoo%val(i) = tmpcoo%val(k)
-      tmpcoo%ia(i)  = tmpcoo%ia(k)
-      tmpcoo%ja(i)  = tmpcoo%ja(k)
-    end if
-  end do
-  call tmpcoo%set_nzeros(i)
-  call op_restr%mv_from(tmpcoo)
-  call op_restr%cscnv(info,type='csr')
-
-
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'starting sphalo/ rwxtd'
-
-  call psb_spspmm(la,tmp_prol,am3,info)
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done SPSPMM 2'
-
-  call psb_sphalo(am3,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.)
-  if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,&
-         & a_err='Extend am3')
-    goto 9999
-  end if
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done sphalo/ rwxtd'
-
-  call psb_spspmm(op_restr,am3,ac,info)
-  if (info == psb_success_) call am3%free()
-  if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_)
-
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,&
-         &a_err='Build ac = op_restr x am3')
-    goto 9999
-  end if
+!!$  ! Get the diagonal D
+!!$  adiag =  a%get_diag(info)
+!!$  if (info == psb_success_) &
+!!$       & call psb_realloc(ncol,adiag,info)    
+!!$  if (info == psb_success_) &
+!!$       & call psb_halo(adiag,desc_a,info)
+!!$  if (info == psb_success_) call a%cp_to_l(la)
+!!$  if (info /= psb_success_) then
+!!$    call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
+!!$    goto 9999
+!!$  end if
+!!$
+!!$  do i=1,size(adiag)
+!!$    if (adiag(i) /= czero) then
+!!$      adinv(i) = cone / adiag(i)
+!!$    else
+!!$      adinv(i) = cone
+!!$    end if
+!!$  end do
+!!$
+!!$
+!!$
+!!$  ! 1. Allocate Ptilde in sparse matrix form 
+!!$  call op_prol%mv_to(tmpcoo)
+!!$  call ptilde%mv_from(tmpcoo)
+!!$  call ptilde%cscnv(info,type='csr')
+!!$
+!!$  if (info == psb_success_) call la%cscnv(am3,info,type='csr',dupl=psb_dupl_add_)
+!!$  if (info == psb_success_) call la%cscnv(da,info,type='csr',dupl=psb_dupl_add_)
+!!$  if (info /= psb_success_) then
+!!$    call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
+!!$    goto 9999
+!!$  end if
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & ' Initial copies done.'
+!!$
+!!$  call da%scal(adinv,info)
+!!$
+!!$  call psb_spspmm(da,ptilde,dap,info)
+!!$
+!!$  if(info /= psb_success_) then
+!!$    call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
+!!$    goto 9999
+!!$  end if
+!!$
+!!$  call dap%clone(atmp,info)
+!!$
+!!$  call psb_sphalo(atmp,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
+!!$  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$  call psb_spspmm(da,atmp,dadap,info)
+!!$  call atmp%free()
+!!$
+!!$  !  !$  write(0,*) 'Columns of AP',psb_sp_get_ncols(ap)
+!!$  !  !$  write(0,*) 'Columns of ADAP',psb_sp_get_ncols(adap)
+!!$  call dap%mv_to(csc_dap)
+!!$  call dadap%mv_to(csc_dadap)
+!!$
+!!$  call csc_mat_col_prod(csc_dap,csc_dadap,omp,info)
+!!$  call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info)
+!!$  call psb_sum(ctxt,omp)
+!!$  call psb_sum(ctxt,oden)
+!!$  ! !$  write(0,*) trim(name),' OMP :',omp
+!!$  ! !$  write(0,*) trim(name),' ODEN:',oden
+!!$
+!!$  omp = omp/oden
+!!$
+!!$  ! !$  write(0,*) 'Check on output prolongator ',omp(1:min(size(omp),10))
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'Done NUMBMM 1'
+!!$
+!!$  call am3%mv_to(acsr3)
+!!$  ! Compute omega_int
+!!$  ommx = czero
+!!$  do i=1, ncol
+!!$    if (ilaggr(i) >0) then 
+!!$      omi(i) = omp(ilaggr(i))
+!!$    else
+!!$      omi(i) = czero
+!!$    end if
+!!$    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
+!!$  end do
+!!$  ! Compute omega_fine
+!!$  do i=1, nrow
+!!$    omf(i) = ommx
+!!$    do j=acsr3%irp(i),acsr3%irp(i+1)-1
+!!$      if(abs(omi(acsr3%ja(j))) .lt. abs(omf(i))) omf(i)=omi(acsr3%ja(j))
+!!$    end do
+!!$ ! !     if(min(real(omf(i)),aimag(omf(i))) < szero) omf(i) = czero
+!!$    if(psb_minreal(omf(i)) < szero) omf(i) = czero
+!!$  end do
+!!$
+!!$  omf(1:nrow) = omf(1:nrow) * adinv(1:nrow)
+!!$
+!!$  if (filter_mat) then
+!!$    !
+!!$    ! Build the filtered matrix Af from A
+!!$    ! 
+!!$    call la%cscnv(acsrf,info,dupl=psb_dupl_add_)
+!!$
+!!$    do i=1,nrow
+!!$      tmp = czero
+!!$      jd  = -1 
+!!$      do j=acsrf%irp(i),acsrf%irp(i+1)-1
+!!$        if (acsrf%ja(j) == i) jd = j 
+!!$        if (abs(acsrf%val(j)) < theta*sqrt(abs(adiag(i)*adiag(acsrf%ja(j))))) then
+!!$          tmp=tmp+acsrf%val(j)
+!!$          acsrf%val(j)=czero
+!!$        endif
+!!$      enddo
+!!$      if (jd == -1) then 
+!!$        write(0,*) 'Wrong input: we need the diagonal!!!!', i
+!!$      else
+!!$        acsrf%val(jd)=acsrf%val(jd)-tmp
+!!$      end if
+!!$    enddo
+!!$    ! Take out zeroed terms 
+!!$    call acsrf%clean_zeros(info)
+!!$
+!!$    !
+!!$    ! Build the smoothed prolongator using the filtered matrix
+!!$    ! 
+!!$    do i=1,acsrf%get_nrows()
+!!$      do j=acsrf%irp(i),acsrf%irp(i+1)-1
+!!$        if (acsrf%ja(j) == i) then 
+!!$          acsrf%val(j) = cone - omf(i)*acsrf%val(j) 
+!!$        else
+!!$          acsrf%val(j) = - omf(i)*acsrf%val(j) 
+!!$        end if
+!!$      end do
+!!$    end do
+!!$
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done gather, going for SYMBMM 1'
+!!$
+!!$    call af%mv_from(acsrf)
+!!$    !
+!!$    ! op_prol = (I-w*D*Af)Ptilde
+!!$    ! Doing it this way means to consider diag(Af_i)
+!!$    ! 
+!!$    !
+!!$    call psb_spspmm(af,ptilde,op_prol,info)
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done SPSPMM 1'
+!!$  else
+!!$    !
+!!$    ! Build the smoothed prolongator using the original matrix
+!!$    !
+!!$    do i=1,acsr3%get_nrows()
+!!$      do j=acsr3%irp(i),acsr3%irp(i+1)-1
+!!$        if (acsr3%ja(j) == i) then 
+!!$          acsr3%val(j) = cone - omf(i)*acsr3%val(j) 
+!!$        else
+!!$          acsr3%val(j) = - omf(i)*acsr3%val(j) 
+!!$        end if
+!!$      end do
+!!$    end do
+!!$
+!!$    call am3%mv_from(acsr3)
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done gather, going for SYMBMM 1'
+!!$    !
+!!$    ! 
+!!$    ! op_prol = (I-w*D*A)Ptilde
+!!$    ! 
+!!$    !
+!!$    call psb_spspmm(am3,ptilde,op_prol,info)
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done NUMBMM 1'
+!!$
+!!$  end if
+!!$
+!!$
+!!$  !
+!!$  ! Ok, let's start over with the restrictor
+!!$  ! 
+!!$  call ptilde%transc(rtilde)
+!!$  call la%cscnv(atmp,info,type='csr')
+!!$  call psb_sphalo(atmp,desc_a,am4,info,&
+!!$       & colcnv=.true.,rowscale=.true.)
+!!$  nrt  = am4%get_nrows() 
+!!$  call am4%csclip(atmp2,info,lone,nrt,lone,ncol)
+!!$  call atmp2%cscnv(info,type='CSR')
+!!$  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=atmp2)      
+!!$  call am4%free()
+!!$  call atmp2%free()
+!!$
+!!$  ! This is to compute the transpose. It ONLY works if the
+!!$  ! original A has a symmetric pattern.
+!!$  call atmp%transc(atmp2) 
+!!$  call atmp2%csclip(dat,info,lone,nrow,lone,ncol)
+!!$  call dat%cscnv(info,type='csr')
+!!$  call dat%scal(adinv,info)
+!!$
+!!$  ! Now for the product. 
+!!$  call psb_spspmm(dat,ptilde,datp,info)
+!!$
+!!$  call datp%clone(atmp2,info)
+!!$  call psb_sphalo(atmp2,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
+!!$  if (info == psb_success_) call psb_rwextd(ncol,atmp2,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$
+!!$  call psb_symbmm(dat,atmp2,datdatp,info)
+!!$  call psb_numbmm(dat,atmp2,datdatp)
+!!$  call atmp2%free()
+!!$
+!!$  call datp%mv_to(csc_datp)    
+!!$  call datdatp%mv_to(csc_datdatp)    
+!!$
+!!$  call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info)
+!!$  call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info)
+!!$  call psb_sum(ctxt,omp)
+!!$  call psb_sum(ctxt,oden)
+!!$
+!!$
+!!$  ! !$  write(debug_unit,*) trim(name),' OMP_R :',omp
+!!$  ! ! $  write(debug_unit,*) trim(name),' ODEN_R:',oden
+!!$  omp = omp/oden
+!!$  ! !$  write(0,*) 'Check on output restrictor',omp(1:min(size(omp),10))
+!!$  ! Compute omega_int
+!!$  ommx = czero
+!!$  do i=1, ncol
+!!$    if (ilaggr(i) >0) then 
+!!$      omi(i) = omp(ilaggr(i))
+!!$    else
+!!$      omi(i) = czero
+!!$    end if
+!!$    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
+!!$  end do
+!!$  ! Compute omega_fine
+!!$  ! Going over the columns of atmp means going over the rows
+!!$  ! of A^T. Hopefully ;-) 
+!!$  call atmp%cp_to(acsc)
+!!$
+!!$  do i=1, nrow
+!!$    omf(i) = ommx
+!!$    do j= acsc%icp(i),acsc%icp(i+1)-1
+!!$      if(abs(omi(acsc%ia(j))) .lt. abs(omf(i))) omf(i)=omi(acsc%ia(j))
+!!$    end do
+!!$ ! !    if(min(real(omf(i)),aimag(omf(i))) < szero) omf(i) = czero
+!!$    if(psb_minreal(omf(i)) < szero) omf(i) = czero
+!!$  end do
+!!$  omf(1:nrow) = omf(1:nrow)*adinv(1:nrow)
+!!$  call psb_halo(omf,desc_a,info)
+!!$  call acsc%free() 
+!!$
+!!$
+!!$  call atmp%mv_to(acsr1)
+!!$
+!!$  do i=1,acsr1%get_nrows()
+!!$    do j=acsr1%irp(i),acsr1%irp(i+1)-1
+!!$      if (acsr1%ja(j) == i) then 
+!!$        acsr1%val(j) = cone - acsr1%val(j)*omf(acsr1%ja(j))
+!!$      else
+!!$        acsr1%val(j) =      - acsr1%val(j)*omf(acsr1%ja(j))
+!!$      end if
+!!$    end do
+!!$  end do
+!!$  call atmp%mv_from(acsr1)
+!!$
+!!$  call rtilde%mv_to(tmpcoo)
+!!$  nzl = tmpcoo%get_nzeros()
+!!$  i=0
+!!$  do k=1, nzl
+!!$    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
+!!$      i = i+1
+!!$      tmpcoo%val(i) = tmpcoo%val(k)
+!!$      tmpcoo%ia(i)  = tmpcoo%ia(k)
+!!$      tmpcoo%ja(i)  = tmpcoo%ja(k)
+!!$    end if
+!!$  end do
+!!$  call tmpcoo%set_nzeros(i)
+!!$  call rtilde%mv_from(tmpcoo)
+!!$  call rtilde%cscnv(info,type='csr')
+!!$
+!!$  call psb_spspmm(rtilde,atmp,op_restr,info)
+!!$
+!!$  !
+!!$  ! Now we have to gather the halo of op_prol, and add it to itself
+!!$  ! to multiply it by A,
+!!$  !
+!!$  call op_prol%clone(tmp_prol,info) 
+!!$  if (info == psb_success_) call psb_sphalo(tmp_prol,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.)
+!!$  if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$  if(info /= psb_success_) then
+!!$    call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol')
+!!$    goto 9999
+!!$  end if
+!!$
+!!$  !
+!!$  ! Now we have to fix this.  The only rows of B that are correct 
+!!$  ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
+!!$  !
+!!$  call op_restr%mv_to(tmpcoo)
+!!$
+!!$  nzl = tmpcoo%get_nzeros()
+!!$  i=0
+!!$  do k=1, nzl
+!!$    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
+!!$      i = i+1
+!!$      tmpcoo%val(i) = tmpcoo%val(k)
+!!$      tmpcoo%ia(i)  = tmpcoo%ia(k)
+!!$      tmpcoo%ja(i)  = tmpcoo%ja(k)
+!!$    end if
+!!$  end do
+!!$  call tmpcoo%set_nzeros(i)
+!!$  call op_restr%mv_from(tmpcoo)
+!!$  call op_restr%cscnv(info,type='csr')
+!!$
+!!$
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'starting sphalo/ rwxtd'
+!!$
+!!$  call psb_spspmm(la,tmp_prol,am3,info)
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'Done SPSPMM 2'
+!!$
+!!$  call psb_sphalo(am3,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.)
+!!$  if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$  if(info /= psb_success_) then
+!!$    call psb_errpush(psb_err_internal_error_,name,&
+!!$         & a_err='Extend am3')
+!!$    goto 9999
+!!$  end if
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'Done sphalo/ rwxtd'
+!!$
+!!$  call psb_spspmm(op_restr,am3,ac,info)
+!!$  if (info == psb_success_) call am3%free()
+!!$  if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_)
+!!$
+!!$  if (info /= psb_success_) then
+!!$    call psb_errpush(psb_err_internal_error_,name,&
+!!$         &a_err='Build ac = op_restr x am3')
+!!$    goto 9999
+!!$  end if
 
 
 

amgprec/impl/aggregator/amg_caggrmat_smth_bld.f90

@@ -116,7 +116,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
   type(amg_sml_parms), intent(inout)      :: parms 
-  type(psb_cspmat_type), intent(out)      :: op_prol,ac,op_restr
+  type(psb_cspmat_type), intent(inout)      :: op_prol,ac,op_restr
   type(psb_lcspmat_type), intent(inout)    :: t_prol
   type(psb_desc_type), intent(inout)       :: desc_ac
   integer(psb_ipk_), intent(out)           :: info

amgprec/impl/aggregator/amg_d_dec_aggregator_tprol.f90

@@ -83,8 +83,8 @@ subroutine  amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
   class(amg_d_dec_aggregator_type), target, intent(inout) :: ag
   type(amg_dml_parms), intent(inout)  :: parms
   type(amg_daggr_data), intent(in)    :: ag_data
-  type(psb_dspmat_type), intent(in)   :: a
-  type(psb_desc_type), intent(in)     :: desc_a
+  type(psb_dspmat_type), intent(inout) :: a
+  type(psb_desc_type), intent(inout)    :: desc_a
   integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
   type(psb_ldspmat_type), intent(out)  :: t_prol
   integer(psb_ipk_), intent(out)      :: info

amgprec/impl/aggregator/amg_d_parmatch_aggregator_inner_mat_asb.F90

@@ -1,4 +1,4 @@
-!   !
+!
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
@@ -34,75 +34,6 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-!  moved here from
-!
-!                             AMG4PSBLAS  Extensions
-!
-!    (C) Copyright 2019
-!
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-!                             MLD2P4  version 2.2
-!    MultiLevel Domain Decomposition Parallel Preconditioners Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!
-!    (C) Copyright 2008-2018
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Daniela di Serafino
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
 ! File: amg_d_parmatch_aggregator_mat_asb.f90
 !
 ! Subroutine: amg_d_parmatch_aggregator_mat_asb
@@ -167,7 +98,11 @@ subroutine  amg_d_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
      & ac,desc_ac, op_prol,op_restr,info)
   use psb_base_mod
   use amg_base_prec_type
+#if defined(SERIAL_MPI)
+    use amg_d_parmatch_aggregator_mod
+#else
   use amg_d_parmatch_aggregator_mod, amg_protect_name => amg_d_parmatch_aggregator_inner_mat_asb
+#endif
   implicit none
   class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
   type(amg_dml_parms), intent(inout)    :: parms
@@ -198,11 +133,11 @@ subroutine  amg_d_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
   ictxt = desc_a%get_context()
   call psb_info(ictxt,me,np)
 
+#if !defined(SERIAL_MPI)
 
   if (debug) write(0,*) me,' ',trim(name),' Start:',&
        & allocated(ag%ac),allocated(ag%desc_ac), allocated(ag%prol),allocated(ag%restr)
 
-
   select case(parms%coarse_mat)
 
   case(amg_distr_mat_)
@@ -220,7 +155,7 @@ subroutine  amg_d_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
     call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
     goto 9999
   end select
-
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_d_parmatch_aggregator_mat_asb.F90

@@ -1,4 +1,4 @@
-!   !
+!
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
@@ -34,78 +34,6 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-!  moved here from
-!
-!                             AMG4PSBLAS  Extensions
-!
-!    (C) Copyright 2019
-!
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-! File: amg_d_base_aggregator_mat_bld.f90
-!
-!
-!                             AMG4PSBLAS  version 2.2
-!    MultiLevel Domain Decomposition Parallel Preconditioners Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!
-!    (C) Copyright 2008-2018
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Daniela di Serafino
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
 ! File: amg_d_parmatch_aggregator_mat_asb.f90
 !
 ! Subroutine: amg_d_parmatch_aggregator_mat_asb
@@ -170,7 +98,11 @@ subroutine  amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
      & ac,desc_ac, op_prol,op_restr,info)
   use psb_base_mod
   use amg_base_prec_type
+#if defined(SERIAL_MPI)
+    use amg_d_parmatch_aggregator_mod
+#else
   use amg_d_parmatch_aggregator_mod, amg_protect_name => amg_d_parmatch_aggregator_mat_asb
+#endif
   implicit none
   class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
   type(amg_dml_parms), intent(inout)    :: parms
@@ -204,6 +136,7 @@ subroutine  amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
   end if
 
 
+#if !defined(SERIAL_MPI)
   if (debug) write(0,*) me,' ',trim(name),' Start:',&
        & allocated(ag%ac),allocated(ag%desc_ac), allocated(ag%prol),allocated(ag%restr)
 
@@ -266,7 +199,7 @@ subroutine  amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
     call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
     goto 9999
   end select
-
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_d_parmatch_aggregator_mat_bld.F90

@@ -1,4 +1,4 @@
-!   !
+!
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
@@ -34,39 +34,6 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-!  moved here from
-!
-!                             AMG4PSBLAS  Extensions
-!
-!    (C) Copyright 2019
-!
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
 !
 ! File: amg_d_base_aggregator_mat_bld.f90
 !
@@ -168,7 +135,11 @@ subroutine  amg_d_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   use psb_base_mod
   use amg_d_inner_mod
   use amg_base_prec_type
+#if defined(SERIAL_MPI)
+    use amg_d_parmatch_aggregator_mod
+#else
   use amg_d_parmatch_aggregator_mod, amg_protect_name => amg_d_parmatch_aggregator_mat_bld
+#endif
   implicit none
 
   class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -205,6 +176,7 @@ subroutine  amg_d_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   ! algorithm specified by
   !
 
+#if !defined(SERIAL_MPI)
   call clean_shortcuts(ag)
   !
   ! When requesting smoothed aggregation we cannot use the
@@ -237,13 +209,15 @@ subroutine  amg_d_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
     call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner aggrmat asb')
     goto 9999
   end if
-
+#endif
   call psb_erractionrestore(err_act)
   return
 
 9999 call psb_error_handler(err_act)
   return
 
+#if !defined(SERIAL_MPI)
+
 contains
   subroutine clean_shortcuts(ag)
     implicit none
@@ -271,5 +245,5 @@ contains
       end if
     end if
   end subroutine clean_shortcuts
-
+#endif
 end subroutine amg_d_parmatch_aggregator_mat_bld

amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90

@@ -1,4 +1,4 @@
-!   !
+!
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
@@ -34,73 +34,6 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-!  moved here from
-!
-!                             AMG4PSBLAS  Extensions
-!
-!    (C) Copyright 2019
-!
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-!                             MLD2P4  version 2.2
-!    MultiLevel Domain Decomposition Parallel Preconditioners Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!
-!    (C) Copyright 2008-2018
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Daniela di Serafino
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
 !
 ! File: amg_d_parmatch_aggregator_tprol.f90
 !
@@ -114,14 +47,18 @@ subroutine  amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
   use psb_base_mod
   use amg_base_prec_type
   use amg_d_inner_mod
+#if defined(SERIAL_MPI)
+    use amg_d_parmatch_aggregator_mod
+#else
   use amg_d_parmatch_aggregator_mod, amg_protect_name => amg_d_parmatch_aggregator_build_tprol
+#endif
   use iso_c_binding
   implicit none
   class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
   type(amg_dml_parms), intent(inout)   :: parms
   type(amg_daggr_data), intent(in)     :: ag_data
   type(psb_dspmat_type), intent(inout) :: a
-  type(psb_desc_type), intent(inout)   :: desc_a
+  type(psb_desc_type), intent(inout)      :: desc_a
   integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
   type(psb_ldspmat_type), intent(out)  :: t_prol
   integer(psb_ipk_), intent(out)      :: info
@@ -181,6 +118,9 @@ subroutine  amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
   call amg_check_def(parms%aggr_ord,'Ordering',&
        &   amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
   call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
+
+#if !defined(SERIAL_MPI)
+
   match_algorithm = ag%matching_alg
   n_sweeps        = ag%n_sweeps
   if (2**n_sweeps /= ag%orig_aggr_size) then
@@ -530,17 +470,11 @@ subroutine  amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
     call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_bootCMatch_if')
     goto 9999
   end if
+#endif
   call psb_erractionrestore(err_act)
   return
 
 9999 call psb_error_handler(err_act)
   return
-contains
-  subroutine do_l1_jacobi(nsweeps,w,a,desc_a)
-    integer(psb_ipk_), intent(in) :: nsweeps
-    real(psb_dpk_), intent(inout) :: w(:)
-    type(psb_dspmat_type), intent(in) :: a
-    type(psb_desc_type), intent(in)   :: desc_a
 
-  end subroutine do_l1_jacobi
 end subroutine amg_d_parmatch_aggregator_build_tprol

amgprec/impl/aggregator/amg_d_parmatch_smth_bld.F90

@@ -1,14 +1,14 @@
 !
 !
-!                             AMG4PSBLAS  version 2.2
-!    MultiLevel Domain Decomposition Parallel Preconditioners Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
 !
-!    (C) Copyright 2008-2018
+!    (C) Copyright 2021
 !
 !        Salvatore Filippone
 !        Pasqua D'Ambra
-!        Daniela di Serafino
+!        Fabio Durastante
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -108,7 +108,11 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   use amg_base_prec_type
   use amg_d_inner_mod
   use amg_d_base_aggregator_mod
+#if defined(SERIAL_MPI)
+    use amg_d_parmatch_aggregator_mod
+#else
   use amg_d_parmatch_aggregator_mod, amg_protect_name => amg_d_parmatch_smth_bld
+#endif
   implicit none
 
   ! Arguments
@@ -118,7 +122,7 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
   type(amg_dml_parms), intent(inout)    :: parms
   type(psb_ldspmat_type), intent(inout)  :: t_prol
-  type(psb_dspmat_type), intent(out)    :: op_prol,ac,op_restr
+  type(psb_dspmat_type), intent(inout)   :: op_prol,ac,op_restr
   type(psb_desc_type), intent(inout)    :: desc_ac
   integer(psb_ipk_), intent(out)           :: info
 
@@ -182,6 +186,8 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
 
   if (do_timings) call psb_tic(idx_phase1)
 
+#if !defined(SERIAL_MPI)
+
   naggr  = nlaggr(me+1)
   ntaggr = sum(nlaggr)
   naggrm1 = sum(nlaggr(1:me))
@@ -372,6 +378,7 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_d_parmatch_spmm_bld.F90

@@ -1,4 +1,4 @@
-!   !
+!
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
@@ -34,40 +34,6 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-!  moved here from
-!
-!
-!                             AMG4PSBLAS  Extensions
-!
-!    (C) Copyright 2019
-!
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
 !
 ! File: amg_daggrmat_nosmth_bld.F90
 !
@@ -133,12 +99,16 @@ subroutine amg_d_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
      & ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_d_inner_mod
+#if defined(SERIAL_MPI)
+    use amg_d_parmatch_aggregator_mod
+#else
   use amg_d_parmatch_aggregator_mod, amg_protect_name => amg_d_parmatch_spmm_bld
+#endif
   implicit none
 
   ! Arguments
   type(psb_dspmat_type), intent(in)       :: a
-  type(psb_desc_type), intent(in)         :: desc_a
+  type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
   type(amg_dml_parms), intent(inout)      :: parms
   type(psb_ldspmat_type), intent(inout)   :: t_prol
@@ -170,6 +140,7 @@ subroutine amg_d_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
 
+#if !defined(SERIAL_MPI)
   call a%cp_to(acsr)
 
   call  amg_d_parmatch_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,&
@@ -183,7 +154,7 @@ subroutine amg_d_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done spmm_bld '
-
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_d_parmatch_spmm_bld_inner.F90

@@ -1,11 +1,14 @@
 !
 !
-!                             AMG4PSBLAS  Extensions
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
 !
-!    (C) Copyright 2019
+!    (C) Copyright 2021
 !
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
+!        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
@@ -96,16 +99,20 @@ subroutine amg_d_parmatch_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,&
      & ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_d_inner_mod
+#if defined(SERIAL_MPI)
+    use amg_d_parmatch_aggregator_mod
+#else
   use amg_d_parmatch_aggregator_mod, amg_protect_name => amg_d_parmatch_spmm_bld_inner
+#endif
   implicit none
 
   ! Arguments
   type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
-  type(psb_desc_type), intent(in)           :: desc_a
+  type(psb_desc_type), intent(inout)          :: desc_a
   integer(psb_lpk_), intent(inout)          :: ilaggr(:), nlaggr(:)
   type(amg_dml_parms), intent(inout)        :: parms
   type(psb_ldspmat_type), intent(inout)     :: t_prol
-  type(psb_dspmat_type), intent(out)        :: ac, op_prol, op_restr
+  type(psb_dspmat_type), intent(inout)      :: ac, op_prol, op_restr
   type(psb_desc_type), intent(out)          :: desc_ac
   integer(psb_ipk_), intent(out)            :: info
 
@@ -156,6 +163,7 @@ subroutine amg_d_parmatch_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,&
   naggrm1 = sum(nlaggr(1:me))
   naggrp1 = sum(nlaggr(1:me+1))
 
+#if !defined(SERIAL_MPI)
   !
   ! Here T_PROL should be arriving with GLOBAL indices on the cols
   ! and LOCAL indices on the rows.
@@ -199,7 +207,7 @@ subroutine amg_d_parmatch_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,&
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '
-
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_d_parmatch_spmm_bld_ov.F90

@@ -1,11 +1,14 @@
 !
 !
-!                             AMG4PSBLAS  Extensions
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
 !
-!    (C) Copyright 2019
+!    (C) Copyright 2021
 !
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
+!        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
@@ -96,12 +99,16 @@ subroutine amg_d_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
      & ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_d_inner_mod
+#if defined(SERIAL_MPI)
+    use amg_d_parmatch_aggregator_mod
+#else
   use amg_d_parmatch_aggregator_mod, amg_protect_name => amg_d_parmatch_spmm_bld_ov
+#endif
   implicit none
 
   ! Arguments
   type(psb_dspmat_type), intent(inout)    :: a
-  type(psb_desc_type), intent(in)         :: desc_a
+  type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
   type(amg_dml_parms), intent(inout)      :: parms
   type(psb_ldspmat_type), intent(inout)   :: t_prol
@@ -134,6 +141,8 @@ subroutine amg_d_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
 
+#if !defined(SERIAL_MPI)
+
   call a%mv_to(acsr)
 
   call  amg_d_parmatch_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,&
@@ -149,7 +158,7 @@ subroutine amg_d_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done spmm_bld '
-
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_d_parmatch_unsmth_bld.F90

@@ -1,14 +1,14 @@
 !
 !
-!                             AMG4PSBLAS  version 2.2
-!    MultiLevel Domain Decomposition Parallel Preconditioners Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
 !
-!    (C) Copyright 2008-2018
+!    (C) Copyright 2021
 !
 !        Salvatore Filippone
 !        Pasqua D'Ambra
-!        Daniela di Serafino
+!        Fabio Durastante
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -34,7 +34,6 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-!
 ! File: amg_d_parmatch_unsmth_bld.F90
 !
 ! Subroutine: amg_d_parmatch_unsmth_bld
@@ -108,7 +107,11 @@ subroutine amg_d_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   use amg_base_prec_type
   use amg_d_inner_mod
   use amg_d_base_aggregator_mod
+#if defined(SERIAL_MPI)
+    use amg_d_parmatch_aggregator_mod
+#else
   use amg_d_parmatch_aggregator_mod, amg_protect_name => amg_d_parmatch_unsmth_bld
+#endif
   implicit none
 
   ! Arguments
@@ -157,6 +160,7 @@ subroutine amg_d_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
 
   call psb_info(ictxt, me, np)
 
+#if !defined(SERIAL_MPI)
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
   ncol  = desc_a%get_local_cols()
@@ -224,7 +228,7 @@ subroutine amg_d_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
     goto 9999
   end if
 
-
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_d_symdec_aggregator_tprol.f90

@@ -86,8 +86,8 @@ subroutine  amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
   class(amg_d_symdec_aggregator_type), target, intent(inout) :: ag
   type(amg_dml_parms), intent(inout)  :: parms
   type(amg_daggr_data), intent(in)    :: ag_data
-  type(psb_dspmat_type), intent(in)   :: a
-  type(psb_desc_type), intent(in)     :: desc_a
+  type(psb_dspmat_type), intent(inout) :: a
+  type(psb_desc_type), intent(inout)   :: desc_a
   integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
   type(psb_ldspmat_type), intent(out)  :: op_prol
   integer(psb_ipk_), intent(out)      :: info

amgprec/impl/aggregator/amg_daggrmat_minnrg_bld.f90

@@ -105,7 +105,7 @@
 !
 !
 subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,info)
+     & ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_d_inner_mod, amg_protect_name => amg_daggrmat_minnrg_bld
@@ -117,8 +117,8 @@ subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
   type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
   type(amg_dml_parms), intent(inout)         :: parms 
-  type(psb_ldspmat_type), intent(inout)       :: op_prol
-  type(psb_ldspmat_type), intent(out)         :: ac,op_restr
+  type(psb_ldspmat_type), intent(inout)       :: t_prol
+  type(psb_dspmat_type), intent(inout)       :: op_prol, ac,op_restr
   type(psb_desc_type), intent(inout)            :: desc_ac
   integer(psb_ipk_), intent(out)                :: info
 
@@ -171,6 +171,8 @@ subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   filter_mat = (parms%aggr_filter == amg_filter_mat_)
 
+  !NEEDS TO BE REWORKED !!
+  
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
@@ -183,361 +185,361 @@ subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
     goto 9999      
   end if
 
-  ! Get the diagonal D
-  adiag =  a%get_diag(info)
-  if (info == psb_success_) &
-       & call psb_realloc(ncol,adiag,info)    
-  if (info == psb_success_) &
-       & call psb_halo(adiag,desc_a,info)
-  if (info == psb_success_) call a%cp_to_l(la)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
-    goto 9999
-  end if
-
-  do i=1,size(adiag)
-    if (adiag(i) /= dzero) then
-      adinv(i) = done / adiag(i)
-    else
-      adinv(i) = done
-    end if
-  end do
-
-
-
-  ! 1. Allocate Ptilde in sparse matrix form 
-  call op_prol%mv_to(tmpcoo)
-  call ptilde%mv_from(tmpcoo)
-  call ptilde%cscnv(info,type='csr')
-
-  if (info == psb_success_) call la%cscnv(am3,info,type='csr',dupl=psb_dupl_add_)
-  if (info == psb_success_) call la%cscnv(da,info,type='csr',dupl=psb_dupl_add_)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
-    goto 9999
-  end if
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & ' Initial copies done.'
-
-  call da%scal(adinv,info)
-
-  call psb_spspmm(da,ptilde,dap,info)
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
-    goto 9999
-  end if
-
-  call dap%clone(atmp,info)
-
-  call psb_sphalo(atmp,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
-  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-  call psb_spspmm(da,atmp,dadap,info)
-  call atmp%free()
-
-  !  !$  write(0,*) 'Columns of AP',psb_sp_get_ncols(ap)
-  !  !$  write(0,*) 'Columns of ADAP',psb_sp_get_ncols(adap)
-  call dap%mv_to(csc_dap)
-  call dadap%mv_to(csc_dadap)
-
-  call csc_mat_col_prod(csc_dap,csc_dadap,omp,info)
-  call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info)
-  call psb_sum(ctxt,omp)
-  call psb_sum(ctxt,oden)
-  ! !$  write(0,*) trim(name),' OMP :',omp
-  ! !$  write(0,*) trim(name),' ODEN:',oden
-
-  omp = omp/oden
-
-  ! !$  write(0,*) 'Check on output prolongator ',omp(1:min(size(omp),10))
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done NUMBMM 1'
-
-  call am3%mv_to(acsr3)
-  ! Compute omega_int
-  ommx = dzero
-  do i=1, ncol
-    if (ilaggr(i) >0) then 
-      omi(i) = omp(ilaggr(i))
-    else
-      omi(i) = dzero
-    end if
-    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
-  end do
-  ! Compute omega_fine
-  do i=1, nrow
-    omf(i) = ommx
-    do j=acsr3%irp(i),acsr3%irp(i+1)-1
-      if(abs(omi(acsr3%ja(j))) .lt. abs(omf(i))) omf(i)=omi(acsr3%ja(j))
-    end do
-!!$    if(min(real(omf(i)),aimag(omf(i))) < dzero) omf(i) = dzero
-    if(psb_minreal(omf(i)) < dzero) omf(i) = dzero
-  end do
-
-  omf(1:nrow) = omf(1:nrow) * adinv(1:nrow)
-
-  if (filter_mat) then
-    !
-    ! Build the filtered matrix Af from A
-    ! 
-    call la%cscnv(acsrf,info,dupl=psb_dupl_add_)
-
-    do i=1,nrow
-      tmp = dzero
-      jd  = -1 
-      do j=acsrf%irp(i),acsrf%irp(i+1)-1
-        if (acsrf%ja(j) == i) jd = j 
-        if (abs(acsrf%val(j)) < theta*sqrt(abs(adiag(i)*adiag(acsrf%ja(j))))) then
-          tmp=tmp+acsrf%val(j)
-          acsrf%val(j)=dzero
-        endif
-      enddo
-      if (jd == -1) then 
-        write(0,*) 'Wrong input: we need the diagonal!!!!', i
-      else
-        acsrf%val(jd)=acsrf%val(jd)-tmp
-      end if
-    enddo
-    ! Take out zeroed terms 
-    call acsrf%clean_zeros(info)
-
-    !
-    ! Build the smoothed prolongator using the filtered matrix
-    ! 
-    do i=1,acsrf%get_nrows()
-      do j=acsrf%irp(i),acsrf%irp(i+1)-1
-        if (acsrf%ja(j) == i) then 
-          acsrf%val(j) = done - omf(i)*acsrf%val(j) 
-        else
-          acsrf%val(j) = - omf(i)*acsrf%val(j) 
-        end if
-      end do
-    end do
-
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done gather, going for SYMBMM 1'
-
-    call af%mv_from(acsrf)
-    !
-    ! op_prol = (I-w*D*Af)Ptilde
-    ! Doing it this way means to consider diag(Af_i)
-    ! 
-    !
-    call psb_spspmm(af,ptilde,op_prol,info)
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done SPSPMM 1'
-  else
-    !
-    ! Build the smoothed prolongator using the original matrix
-    !
-    do i=1,acsr3%get_nrows()
-      do j=acsr3%irp(i),acsr3%irp(i+1)-1
-        if (acsr3%ja(j) == i) then 
-          acsr3%val(j) = done - omf(i)*acsr3%val(j) 
-        else
-          acsr3%val(j) = - omf(i)*acsr3%val(j) 
-        end if
-      end do
-    end do
-
-    call am3%mv_from(acsr3)
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done gather, going for SYMBMM 1'
-    !
-    ! 
-    ! op_prol = (I-w*D*A)Ptilde
-    ! 
-    !
-    call psb_spspmm(am3,ptilde,op_prol,info)
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done NUMBMM 1'
-
-  end if
-
-
-  !
-  ! Ok, let's start over with the restrictor
-  ! 
-  call ptilde%transc(rtilde)
-  call la%cscnv(atmp,info,type='csr')
-  call psb_sphalo(atmp,desc_a,am4,info,&
-       & colcnv=.true.,rowscale=.true.)
-  nrt  = am4%get_nrows() 
-  call am4%csclip(atmp2,info,lone,nrt,lone,ncol)
-  call atmp2%cscnv(info,type='CSR')
-  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=atmp2)      
-  call am4%free()
-  call atmp2%free()
-
-  ! This is to compute the transpose. It ONLY works if the
-  ! original A has a symmetric pattern.
-  call atmp%transc(atmp2) 
-  call atmp2%csclip(dat,info,lone,nrow,lone,ncol)
-  call dat%cscnv(info,type='csr')
-  call dat%scal(adinv,info)
-
-  ! Now for the product. 
-  call psb_spspmm(dat,ptilde,datp,info)
-
-  call datp%clone(atmp2,info)
-  call psb_sphalo(atmp2,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
-  if (info == psb_success_) call psb_rwextd(ncol,atmp2,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-
-  call psb_symbmm(dat,atmp2,datdatp,info)
-  call psb_numbmm(dat,atmp2,datdatp)
-  call atmp2%free()
-
-  call datp%mv_to(csc_datp)    
-  call datdatp%mv_to(csc_datdatp)    
-
-  call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info)
-  call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info)
-  call psb_sum(ctxt,omp)
-  call psb_sum(ctxt,oden)
-
-
-  ! !$  write(debug_unit,*) trim(name),' OMP_R :',omp
-  ! ! $  write(debug_unit,*) trim(name),' ODEN_R:',oden
-  omp = omp/oden
-  ! !$  write(0,*) 'Check on output restrictor',omp(1:min(size(omp),10))
-  ! Compute omega_int
-  ommx = dzero
-  do i=1, ncol
-    if (ilaggr(i) >0) then 
-      omi(i) = omp(ilaggr(i))
-    else
-      omi(i) = dzero
-    end if
-    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
-  end do
-  ! Compute omega_fine
-  ! Going over the columns of atmp means going over the rows
-  ! of A^T. Hopefully ;-) 
-  call atmp%cp_to(acsc)
-
-  do i=1, nrow
-    omf(i) = ommx
-    do j= acsc%icp(i),acsc%icp(i+1)-1
-      if(abs(omi(acsc%ia(j))) .lt. abs(omf(i))) omf(i)=omi(acsc%ia(j))
-    end do
-!!$    if(min(real(omf(i)),aimag(omf(i))) < dzero) omf(i) = dzero
-    if(psb_minreal(omf(i)) < dzero) omf(i) = dzero
-  end do
-  omf(1:nrow) = omf(1:nrow)*adinv(1:nrow)
-  call psb_halo(omf,desc_a,info)
-  call acsc%free() 
-
-
-  call atmp%mv_to(acsr1)
-
-  do i=1,acsr1%get_nrows()
-    do j=acsr1%irp(i),acsr1%irp(i+1)-1
-      if (acsr1%ja(j) == i) then 
-        acsr1%val(j) = done - acsr1%val(j)*omf(acsr1%ja(j))
-      else
-        acsr1%val(j) =      - acsr1%val(j)*omf(acsr1%ja(j))
-      end if
-    end do
-  end do
-  call atmp%mv_from(acsr1)
-
-  call rtilde%mv_to(tmpcoo)
-  nzl = tmpcoo%get_nzeros()
-  i=0
-  do k=1, nzl
-    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
-      i = i+1
-      tmpcoo%val(i) = tmpcoo%val(k)
-      tmpcoo%ia(i)  = tmpcoo%ia(k)
-      tmpcoo%ja(i)  = tmpcoo%ja(k)
-    end if
-  end do
-  call tmpcoo%set_nzeros(i)
-  call rtilde%mv_from(tmpcoo)
-  call rtilde%cscnv(info,type='csr')
-
-  call psb_spspmm(rtilde,atmp,op_restr,info)
-
-  !
-  ! Now we have to gather the halo of op_prol, and add it to itself
-  ! to multiply it by A,
-  !
-  call op_prol%clone(tmp_prol,info) 
-  if (info == psb_success_) call psb_sphalo(tmp_prol,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.)
-  if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol')
-    goto 9999
-  end if
-
-  !
-  ! Now we have to fix this.  The only rows of B that are correct 
-  ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
-  !
-  call op_restr%mv_to(tmpcoo)
-
-  nzl = tmpcoo%get_nzeros()
-  i=0
-  do k=1, nzl
-    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
-      i = i+1
-      tmpcoo%val(i) = tmpcoo%val(k)
-      tmpcoo%ia(i)  = tmpcoo%ia(k)
-      tmpcoo%ja(i)  = tmpcoo%ja(k)
-    end if
-  end do
-  call tmpcoo%set_nzeros(i)
-  call op_restr%mv_from(tmpcoo)
-  call op_restr%cscnv(info,type='csr')
-
-
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'starting sphalo/ rwxtd'
-
-  call psb_spspmm(la,tmp_prol,am3,info)
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done SPSPMM 2'
-
-  call psb_sphalo(am3,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.)
-  if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,&
-         & a_err='Extend am3')
-    goto 9999
-  end if
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done sphalo/ rwxtd'
-
-  call psb_spspmm(op_restr,am3,ac,info)
-  if (info == psb_success_) call am3%free()
-  if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_)
-
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,&
-         &a_err='Build ac = op_restr x am3')
-    goto 9999
-  end if
+!!$  ! Get the diagonal D
+!!$  adiag =  a%get_diag(info)
+!!$  if (info == psb_success_) &
+!!$       & call psb_realloc(ncol,adiag,info)    
+!!$  if (info == psb_success_) &
+!!$       & call psb_halo(adiag,desc_a,info)
+!!$  if (info == psb_success_) call a%cp_to_l(la)
+!!$  if (info /= psb_success_) then
+!!$    call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
+!!$    goto 9999
+!!$  end if
+!!$
+!!$  do i=1,size(adiag)
+!!$    if (adiag(i) /= dzero) then
+!!$      adinv(i) = done / adiag(i)
+!!$    else
+!!$      adinv(i) = done
+!!$    end if
+!!$  end do
+!!$
+!!$
+!!$
+!!$  ! 1. Allocate Ptilde in sparse matrix form 
+!!$  call op_prol%mv_to(tmpcoo)
+!!$  call ptilde%mv_from(tmpcoo)
+!!$  call ptilde%cscnv(info,type='csr')
+!!$
+!!$  if (info == psb_success_) call la%cscnv(am3,info,type='csr',dupl=psb_dupl_add_)
+!!$  if (info == psb_success_) call la%cscnv(da,info,type='csr',dupl=psb_dupl_add_)
+!!$  if (info /= psb_success_) then
+!!$    call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
+!!$    goto 9999
+!!$  end if
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & ' Initial copies done.'
+!!$
+!!$  call da%scal(adinv,info)
+!!$
+!!$  call psb_spspmm(da,ptilde,dap,info)
+!!$
+!!$  if(info /= psb_success_) then
+!!$    call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
+!!$    goto 9999
+!!$  end if
+!!$
+!!$  call dap%clone(atmp,info)
+!!$
+!!$  call psb_sphalo(atmp,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
+!!$  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$  call psb_spspmm(da,atmp,dadap,info)
+!!$  call atmp%free()
+!!$
+!!$  !  !$  write(0,*) 'Columns of AP',psb_sp_get_ncols(ap)
+!!$  !  !$  write(0,*) 'Columns of ADAP',psb_sp_get_ncols(adap)
+!!$  call dap%mv_to(csc_dap)
+!!$  call dadap%mv_to(csc_dadap)
+!!$
+!!$  call csc_mat_col_prod(csc_dap,csc_dadap,omp,info)
+!!$  call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info)
+!!$  call psb_sum(ctxt,omp)
+!!$  call psb_sum(ctxt,oden)
+!!$  ! !$  write(0,*) trim(name),' OMP :',omp
+!!$  ! !$  write(0,*) trim(name),' ODEN:',oden
+!!$
+!!$  omp = omp/oden
+!!$
+!!$  ! !$  write(0,*) 'Check on output prolongator ',omp(1:min(size(omp),10))
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'Done NUMBMM 1'
+!!$
+!!$  call am3%mv_to(acsr3)
+!!$  ! Compute omega_int
+!!$  ommx = dzero
+!!$  do i=1, ncol
+!!$    if (ilaggr(i) >0) then 
+!!$      omi(i) = omp(ilaggr(i))
+!!$    else
+!!$      omi(i) = dzero
+!!$    end if
+!!$    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
+!!$  end do
+!!$  ! Compute omega_fine
+!!$  do i=1, nrow
+!!$    omf(i) = ommx
+!!$    do j=acsr3%irp(i),acsr3%irp(i+1)-1
+!!$      if(abs(omi(acsr3%ja(j))) .lt. abs(omf(i))) omf(i)=omi(acsr3%ja(j))
+!!$    end do
+!!$ ! !     if(min(real(omf(i)),aimag(omf(i))) < dzero) omf(i) = dzero
+!!$    if(psb_minreal(omf(i)) < dzero) omf(i) = dzero
+!!$  end do
+!!$
+!!$  omf(1:nrow) = omf(1:nrow) * adinv(1:nrow)
+!!$
+!!$  if (filter_mat) then
+!!$    !
+!!$    ! Build the filtered matrix Af from A
+!!$    ! 
+!!$    call la%cscnv(acsrf,info,dupl=psb_dupl_add_)
+!!$
+!!$    do i=1,nrow
+!!$      tmp = dzero
+!!$      jd  = -1 
+!!$      do j=acsrf%irp(i),acsrf%irp(i+1)-1
+!!$        if (acsrf%ja(j) == i) jd = j 
+!!$        if (abs(acsrf%val(j)) < theta*sqrt(abs(adiag(i)*adiag(acsrf%ja(j))))) then
+!!$          tmp=tmp+acsrf%val(j)
+!!$          acsrf%val(j)=dzero
+!!$        endif
+!!$      enddo
+!!$      if (jd == -1) then 
+!!$        write(0,*) 'Wrong input: we need the diagonal!!!!', i
+!!$      else
+!!$        acsrf%val(jd)=acsrf%val(jd)-tmp
+!!$      end if
+!!$    enddo
+!!$    ! Take out zeroed terms 
+!!$    call acsrf%clean_zeros(info)
+!!$
+!!$    !
+!!$    ! Build the smoothed prolongator using the filtered matrix
+!!$    ! 
+!!$    do i=1,acsrf%get_nrows()
+!!$      do j=acsrf%irp(i),acsrf%irp(i+1)-1
+!!$        if (acsrf%ja(j) == i) then 
+!!$          acsrf%val(j) = done - omf(i)*acsrf%val(j) 
+!!$        else
+!!$          acsrf%val(j) = - omf(i)*acsrf%val(j) 
+!!$        end if
+!!$      end do
+!!$    end do
+!!$
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done gather, going for SYMBMM 1'
+!!$
+!!$    call af%mv_from(acsrf)
+!!$    !
+!!$    ! op_prol = (I-w*D*Af)Ptilde
+!!$    ! Doing it this way means to consider diag(Af_i)
+!!$    ! 
+!!$    !
+!!$    call psb_spspmm(af,ptilde,op_prol,info)
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done SPSPMM 1'
+!!$  else
+!!$    !
+!!$    ! Build the smoothed prolongator using the original matrix
+!!$    !
+!!$    do i=1,acsr3%get_nrows()
+!!$      do j=acsr3%irp(i),acsr3%irp(i+1)-1
+!!$        if (acsr3%ja(j) == i) then 
+!!$          acsr3%val(j) = done - omf(i)*acsr3%val(j) 
+!!$        else
+!!$          acsr3%val(j) = - omf(i)*acsr3%val(j) 
+!!$        end if
+!!$      end do
+!!$    end do
+!!$
+!!$    call am3%mv_from(acsr3)
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done gather, going for SYMBMM 1'
+!!$    !
+!!$    ! 
+!!$    ! op_prol = (I-w*D*A)Ptilde
+!!$    ! 
+!!$    !
+!!$    call psb_spspmm(am3,ptilde,op_prol,info)
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done NUMBMM 1'
+!!$
+!!$  end if
+!!$
+!!$
+!!$  !
+!!$  ! Ok, let's start over with the restrictor
+!!$  ! 
+!!$  call ptilde%transc(rtilde)
+!!$  call la%cscnv(atmp,info,type='csr')
+!!$  call psb_sphalo(atmp,desc_a,am4,info,&
+!!$       & colcnv=.true.,rowscale=.true.)
+!!$  nrt  = am4%get_nrows() 
+!!$  call am4%csclip(atmp2,info,lone,nrt,lone,ncol)
+!!$  call atmp2%cscnv(info,type='CSR')
+!!$  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=atmp2)      
+!!$  call am4%free()
+!!$  call atmp2%free()
+!!$
+!!$  ! This is to compute the transpose. It ONLY works if the
+!!$  ! original A has a symmetric pattern.
+!!$  call atmp%transc(atmp2) 
+!!$  call atmp2%csclip(dat,info,lone,nrow,lone,ncol)
+!!$  call dat%cscnv(info,type='csr')
+!!$  call dat%scal(adinv,info)
+!!$
+!!$  ! Now for the product. 
+!!$  call psb_spspmm(dat,ptilde,datp,info)
+!!$
+!!$  call datp%clone(atmp2,info)
+!!$  call psb_sphalo(atmp2,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
+!!$  if (info == psb_success_) call psb_rwextd(ncol,atmp2,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$
+!!$  call psb_symbmm(dat,atmp2,datdatp,info)
+!!$  call psb_numbmm(dat,atmp2,datdatp)
+!!$  call atmp2%free()
+!!$
+!!$  call datp%mv_to(csc_datp)    
+!!$  call datdatp%mv_to(csc_datdatp)    
+!!$
+!!$  call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info)
+!!$  call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info)
+!!$  call psb_sum(ctxt,omp)
+!!$  call psb_sum(ctxt,oden)
+!!$
+!!$
+!!$  ! !$  write(debug_unit,*) trim(name),' OMP_R :',omp
+!!$  ! ! $  write(debug_unit,*) trim(name),' ODEN_R:',oden
+!!$  omp = omp/oden
+!!$  ! !$  write(0,*) 'Check on output restrictor',omp(1:min(size(omp),10))
+!!$  ! Compute omega_int
+!!$  ommx = dzero
+!!$  do i=1, ncol
+!!$    if (ilaggr(i) >0) then 
+!!$      omi(i) = omp(ilaggr(i))
+!!$    else
+!!$      omi(i) = dzero
+!!$    end if
+!!$    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
+!!$  end do
+!!$  ! Compute omega_fine
+!!$  ! Going over the columns of atmp means going over the rows
+!!$  ! of A^T. Hopefully ;-) 
+!!$  call atmp%cp_to(acsc)
+!!$
+!!$  do i=1, nrow
+!!$    omf(i) = ommx
+!!$    do j= acsc%icp(i),acsc%icp(i+1)-1
+!!$      if(abs(omi(acsc%ia(j))) .lt. abs(omf(i))) omf(i)=omi(acsc%ia(j))
+!!$    end do
+!!$ ! !    if(min(real(omf(i)),aimag(omf(i))) < dzero) omf(i) = dzero
+!!$    if(psb_minreal(omf(i)) < dzero) omf(i) = dzero
+!!$  end do
+!!$  omf(1:nrow) = omf(1:nrow)*adinv(1:nrow)
+!!$  call psb_halo(omf,desc_a,info)
+!!$  call acsc%free() 
+!!$
+!!$
+!!$  call atmp%mv_to(acsr1)
+!!$
+!!$  do i=1,acsr1%get_nrows()
+!!$    do j=acsr1%irp(i),acsr1%irp(i+1)-1
+!!$      if (acsr1%ja(j) == i) then 
+!!$        acsr1%val(j) = done - acsr1%val(j)*omf(acsr1%ja(j))
+!!$      else
+!!$        acsr1%val(j) =      - acsr1%val(j)*omf(acsr1%ja(j))
+!!$      end if
+!!$    end do
+!!$  end do
+!!$  call atmp%mv_from(acsr1)
+!!$
+!!$  call rtilde%mv_to(tmpcoo)
+!!$  nzl = tmpcoo%get_nzeros()
+!!$  i=0
+!!$  do k=1, nzl
+!!$    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
+!!$      i = i+1
+!!$      tmpcoo%val(i) = tmpcoo%val(k)
+!!$      tmpcoo%ia(i)  = tmpcoo%ia(k)
+!!$      tmpcoo%ja(i)  = tmpcoo%ja(k)
+!!$    end if
+!!$  end do
+!!$  call tmpcoo%set_nzeros(i)
+!!$  call rtilde%mv_from(tmpcoo)
+!!$  call rtilde%cscnv(info,type='csr')
+!!$
+!!$  call psb_spspmm(rtilde,atmp,op_restr,info)
+!!$
+!!$  !
+!!$  ! Now we have to gather the halo of op_prol, and add it to itself
+!!$  ! to multiply it by A,
+!!$  !
+!!$  call op_prol%clone(tmp_prol,info) 
+!!$  if (info == psb_success_) call psb_sphalo(tmp_prol,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.)
+!!$  if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$  if(info /= psb_success_) then
+!!$    call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol')
+!!$    goto 9999
+!!$  end if
+!!$
+!!$  !
+!!$  ! Now we have to fix this.  The only rows of B that are correct 
+!!$  ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
+!!$  !
+!!$  call op_restr%mv_to(tmpcoo)
+!!$
+!!$  nzl = tmpcoo%get_nzeros()
+!!$  i=0
+!!$  do k=1, nzl
+!!$    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
+!!$      i = i+1
+!!$      tmpcoo%val(i) = tmpcoo%val(k)
+!!$      tmpcoo%ia(i)  = tmpcoo%ia(k)
+!!$      tmpcoo%ja(i)  = tmpcoo%ja(k)
+!!$    end if
+!!$  end do
+!!$  call tmpcoo%set_nzeros(i)
+!!$  call op_restr%mv_from(tmpcoo)
+!!$  call op_restr%cscnv(info,type='csr')
+!!$
+!!$
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'starting sphalo/ rwxtd'
+!!$
+!!$  call psb_spspmm(la,tmp_prol,am3,info)
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'Done SPSPMM 2'
+!!$
+!!$  call psb_sphalo(am3,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.)
+!!$  if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$  if(info /= psb_success_) then
+!!$    call psb_errpush(psb_err_internal_error_,name,&
+!!$         & a_err='Extend am3')
+!!$    goto 9999
+!!$  end if
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'Done sphalo/ rwxtd'
+!!$
+!!$  call psb_spspmm(op_restr,am3,ac,info)
+!!$  if (info == psb_success_) call am3%free()
+!!$  if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_)
+!!$
+!!$  if (info /= psb_success_) then
+!!$    call psb_errpush(psb_err_internal_error_,name,&
+!!$         &a_err='Build ac = op_restr x am3')
+!!$    goto 9999
+!!$  end if
 
 
 

amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90

@@ -116,7 +116,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
   type(amg_dml_parms), intent(inout)      :: parms 
-  type(psb_dspmat_type), intent(out)      :: op_prol,ac,op_restr
+  type(psb_dspmat_type), intent(inout)      :: op_prol,ac,op_restr
   type(psb_ldspmat_type), intent(inout)    :: t_prol
   type(psb_desc_type), intent(inout)       :: desc_ac
   integer(psb_ipk_), intent(out)           :: info

amgprec/impl/aggregator/amg_s_dec_aggregator_tprol.f90

@@ -83,8 +83,8 @@ subroutine  amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
   class(amg_s_dec_aggregator_type), target, intent(inout) :: ag
   type(amg_sml_parms), intent(inout)  :: parms
   type(amg_saggr_data), intent(in)    :: ag_data
-  type(psb_sspmat_type), intent(in)   :: a
-  type(psb_desc_type), intent(in)     :: desc_a
+  type(psb_sspmat_type), intent(inout) :: a
+  type(psb_desc_type), intent(inout)    :: desc_a
   integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
   type(psb_lsspmat_type), intent(out)  :: t_prol
   integer(psb_ipk_), intent(out)      :: info

amgprec/impl/aggregator/amg_s_parmatch_aggregator_inner_mat_asb.F90

@@ -1,4 +1,4 @@
-!   !
+!
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
@@ -34,75 +34,6 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-!  moved here from
-!
-!                             AMG4PSBLAS  Extensions
-!
-!    (C) Copyright 2019
-!
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-!                             MLD2P4  version 2.2
-!    MultiLevel Domain Decomposition Parallel Preconditioners Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!
-!    (C) Copyright 2008-2018
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Daniela di Serafino
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
 ! File: amg_s_parmatch_aggregator_mat_asb.f90
 !
 ! Subroutine: amg_s_parmatch_aggregator_mat_asb
@@ -167,7 +98,11 @@ subroutine  amg_s_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
      & ac,desc_ac, op_prol,op_restr,info)
   use psb_base_mod
   use amg_base_prec_type
+#if defined(SERIAL_MPI)
+    use amg_s_parmatch_aggregator_mod
+#else
   use amg_s_parmatch_aggregator_mod, amg_protect_name => amg_s_parmatch_aggregator_inner_mat_asb
+#endif
   implicit none
   class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
   type(amg_sml_parms), intent(inout)    :: parms
@@ -198,11 +133,11 @@ subroutine  amg_s_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
   ictxt = desc_a%get_context()
   call psb_info(ictxt,me,np)
 
+#if !defined(SERIAL_MPI)
 
   if (debug) write(0,*) me,' ',trim(name),' Start:',&
        & allocated(ag%ac),allocated(ag%desc_ac), allocated(ag%prol),allocated(ag%restr)
 
-
   select case(parms%coarse_mat)
 
   case(amg_distr_mat_)
@@ -220,7 +155,7 @@ subroutine  amg_s_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
     call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
     goto 9999
   end select
-
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_s_parmatch_aggregator_mat_asb.F90

@@ -1,4 +1,4 @@
-!   !
+!
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
@@ -34,78 +34,6 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-!  moved here from
-!
-!                             AMG4PSBLAS  Extensions
-!
-!    (C) Copyright 2019
-!
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-! File: amg_s_base_aggregator_mat_bld.f90
-!
-!
-!                             AMG4PSBLAS  version 2.2
-!    MultiLevel Domain Decomposition Parallel Preconditioners Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!
-!    (C) Copyright 2008-2018
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Daniela di Serafino
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
 ! File: amg_s_parmatch_aggregator_mat_asb.f90
 !
 ! Subroutine: amg_s_parmatch_aggregator_mat_asb
@@ -170,7 +98,11 @@ subroutine  amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
      & ac,desc_ac, op_prol,op_restr,info)
   use psb_base_mod
   use amg_base_prec_type
+#if defined(SERIAL_MPI)
+    use amg_s_parmatch_aggregator_mod
+#else
   use amg_s_parmatch_aggregator_mod, amg_protect_name => amg_s_parmatch_aggregator_mat_asb
+#endif
   implicit none
   class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
   type(amg_sml_parms), intent(inout)    :: parms
@@ -204,6 +136,7 @@ subroutine  amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
   end if
 
 
+#if !defined(SERIAL_MPI)
   if (debug) write(0,*) me,' ',trim(name),' Start:',&
        & allocated(ag%ac),allocated(ag%desc_ac), allocated(ag%prol),allocated(ag%restr)
 
@@ -266,7 +199,7 @@ subroutine  amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
     call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
     goto 9999
   end select
-
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_s_parmatch_aggregator_mat_bld.F90

@@ -1,4 +1,4 @@
-!   !
+!
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
@@ -34,39 +34,6 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-!  moved here from
-!
-!                             AMG4PSBLAS  Extensions
-!
-!    (C) Copyright 2019
-!
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
 !
 ! File: amg_s_base_aggregator_mat_bld.f90
 !
@@ -168,7 +135,11 @@ subroutine  amg_s_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   use psb_base_mod
   use amg_s_inner_mod
   use amg_base_prec_type
+#if defined(SERIAL_MPI)
+    use amg_s_parmatch_aggregator_mod
+#else
   use amg_s_parmatch_aggregator_mod, amg_protect_name => amg_s_parmatch_aggregator_mat_bld
+#endif
   implicit none
 
   class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -205,6 +176,7 @@ subroutine  amg_s_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   ! algorithm specified by
   !
 
+#if !defined(SERIAL_MPI)
   call clean_shortcuts(ag)
   !
   ! When requesting smoothed aggregation we cannot use the
@@ -237,13 +209,15 @@ subroutine  amg_s_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
     call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner aggrmat asb')
     goto 9999
   end if
-
+#endif
   call psb_erractionrestore(err_act)
   return
 
 9999 call psb_error_handler(err_act)
   return
 
+#if !defined(SERIAL_MPI)
+
 contains
   subroutine clean_shortcuts(ag)
     implicit none
@@ -271,5 +245,5 @@ contains
       end if
     end if
   end subroutine clean_shortcuts
-
+#endif
 end subroutine amg_s_parmatch_aggregator_mat_bld

amgprec/impl/aggregator/amg_s_parmatch_aggregator_tprol.F90

@@ -1,4 +1,4 @@
-!   !
+!
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
@@ -34,73 +34,6 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-!  moved here from
-!
-!                             AMG4PSBLAS  Extensions
-!
-!    (C) Copyright 2019
-!
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-!                             MLD2P4  version 2.2
-!    MultiLevel Domain Decomposition Parallel Preconditioners Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!
-!    (C) Copyright 2008-2018
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Daniela di Serafino
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
 !
 ! File: amg_s_parmatch_aggregator_tprol.f90
 !
@@ -114,14 +47,18 @@ subroutine  amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
   use psb_base_mod
   use amg_base_prec_type
   use amg_s_inner_mod
+#if defined(SERIAL_MPI)
+    use amg_s_parmatch_aggregator_mod
+#else
   use amg_s_parmatch_aggregator_mod, amg_protect_name => amg_s_parmatch_aggregator_build_tprol
+#endif
   use iso_c_binding
   implicit none
   class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
   type(amg_sml_parms), intent(inout)   :: parms
   type(amg_saggr_data), intent(in)     :: ag_data
   type(psb_sspmat_type), intent(inout) :: a
-  type(psb_desc_type), intent(inout)   :: desc_a
+  type(psb_desc_type), intent(inout)      :: desc_a
   integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
   type(psb_lsspmat_type), intent(out)  :: t_prol
   integer(psb_ipk_), intent(out)      :: info
@@ -181,6 +118,9 @@ subroutine  amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
   call amg_check_def(parms%aggr_ord,'Ordering',&
        &   amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
   call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
+
+#if !defined(SERIAL_MPI)
+
   match_algorithm = ag%matching_alg
   n_sweeps        = ag%n_sweeps
   if (2**n_sweeps /= ag%orig_aggr_size) then
@@ -530,17 +470,11 @@ subroutine  amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
     call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_bootCMatch_if')
     goto 9999
   end if
+#endif
   call psb_erractionrestore(err_act)
   return
 
 9999 call psb_error_handler(err_act)
   return
-contains
-  subroutine do_l1_jacobi(nsweeps,w,a,desc_a)
-    integer(psb_ipk_), intent(in) :: nsweeps
-    real(psb_dpk_), intent(inout) :: w(:)
-    type(psb_sspmat_type), intent(in) :: a
-    type(psb_desc_type), intent(in)   :: desc_a
 
-  end subroutine do_l1_jacobi
 end subroutine amg_s_parmatch_aggregator_build_tprol

amgprec/impl/aggregator/amg_s_parmatch_smth_bld.F90

@@ -1,14 +1,14 @@
 !
 !
-!                             AMG4PSBLAS  version 2.2
-!    MultiLevel Domain Decomposition Parallel Preconditioners Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
 !
-!    (C) Copyright 2008-2018
+!    (C) Copyright 2021
 !
 !        Salvatore Filippone
 !        Pasqua D'Ambra
-!        Daniela di Serafino
+!        Fabio Durastante
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -108,7 +108,11 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   use amg_base_prec_type
   use amg_s_inner_mod
   use amg_s_base_aggregator_mod
+#if defined(SERIAL_MPI)
+    use amg_s_parmatch_aggregator_mod
+#else
   use amg_s_parmatch_aggregator_mod, amg_protect_name => amg_s_parmatch_smth_bld
+#endif
   implicit none
 
   ! Arguments
@@ -118,7 +122,7 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
   type(amg_sml_parms), intent(inout)    :: parms
   type(psb_lsspmat_type), intent(inout)  :: t_prol
-  type(psb_sspmat_type), intent(out)    :: op_prol,ac,op_restr
+  type(psb_sspmat_type), intent(inout)   :: op_prol,ac,op_restr
   type(psb_desc_type), intent(inout)    :: desc_ac
   integer(psb_ipk_), intent(out)           :: info
 
@@ -182,6 +186,8 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
 
   if (do_timings) call psb_tic(idx_phase1)
 
+#if !defined(SERIAL_MPI)
+
   naggr  = nlaggr(me+1)
   ntaggr = sum(nlaggr)
   naggrm1 = sum(nlaggr(1:me))
@@ -372,6 +378,7 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_s_parmatch_spmm_bld.F90

@@ -1,4 +1,4 @@
-!   !
+!
 !
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
@@ -34,40 +34,6 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-!  moved here from
-!
-!
-!                             AMG4PSBLAS  Extensions
-!
-!    (C) Copyright 2019
-!
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
 !
 ! File: amg_saggrmat_nosmth_bld.F90
 !
@@ -133,12 +99,16 @@ subroutine amg_s_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
      & ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_s_inner_mod
+#if defined(SERIAL_MPI)
+    use amg_s_parmatch_aggregator_mod
+#else
   use amg_s_parmatch_aggregator_mod, amg_protect_name => amg_s_parmatch_spmm_bld
+#endif
   implicit none
 
   ! Arguments
   type(psb_sspmat_type), intent(in)       :: a
-  type(psb_desc_type), intent(in)         :: desc_a
+  type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
   type(amg_sml_parms), intent(inout)      :: parms
   type(psb_lsspmat_type), intent(inout)   :: t_prol
@@ -170,6 +140,7 @@ subroutine amg_s_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
 
+#if !defined(SERIAL_MPI)
   call a%cp_to(acsr)
 
   call  amg_s_parmatch_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,&
@@ -183,7 +154,7 @@ subroutine amg_s_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done spmm_bld '
-
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_s_parmatch_spmm_bld_inner.F90

@@ -1,11 +1,14 @@
 !
 !
-!                             AMG4PSBLAS  Extensions
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
 !
-!    (C) Copyright 2019
+!    (C) Copyright 2021
 !
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
+!        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
@@ -96,16 +99,20 @@ subroutine amg_s_parmatch_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,&
      & ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_s_inner_mod
+#if defined(SERIAL_MPI)
+    use amg_s_parmatch_aggregator_mod
+#else
   use amg_s_parmatch_aggregator_mod, amg_protect_name => amg_s_parmatch_spmm_bld_inner
+#endif
   implicit none
 
   ! Arguments
   type(psb_s_csr_sparse_mat), intent(inout) :: a_csr
-  type(psb_desc_type), intent(in)           :: desc_a
+  type(psb_desc_type), intent(inout)          :: desc_a
   integer(psb_lpk_), intent(inout)          :: ilaggr(:), nlaggr(:)
   type(amg_sml_parms), intent(inout)        :: parms
   type(psb_lsspmat_type), intent(inout)     :: t_prol
-  type(psb_sspmat_type), intent(out)        :: ac, op_prol, op_restr
+  type(psb_sspmat_type), intent(inout)      :: ac, op_prol, op_restr
   type(psb_desc_type), intent(out)          :: desc_ac
   integer(psb_ipk_), intent(out)            :: info
 
@@ -156,6 +163,7 @@ subroutine amg_s_parmatch_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,&
   naggrm1 = sum(nlaggr(1:me))
   naggrp1 = sum(nlaggr(1:me+1))
 
+#if !defined(SERIAL_MPI)
   !
   ! Here T_PROL should be arriving with GLOBAL indices on the cols
   ! and LOCAL indices on the rows.
@@ -199,7 +207,7 @@ subroutine amg_s_parmatch_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,&
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '
-
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_s_parmatch_spmm_bld_ov.F90

@@ -1,11 +1,14 @@
 !
 !
-!                             AMG4PSBLAS  Extensions
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
 !
-!    (C) Copyright 2019
+!    (C) Copyright 2021
 !
-!                        Salvatore Filippone  Cranfield University
-!        Pasqua D'Ambra         IAC-CNR, Naples, IT
+!        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
@@ -96,12 +99,16 @@ subroutine amg_s_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
      & ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_s_inner_mod
+#if defined(SERIAL_MPI)
+    use amg_s_parmatch_aggregator_mod
+#else
   use amg_s_parmatch_aggregator_mod, amg_protect_name => amg_s_parmatch_spmm_bld_ov
+#endif
   implicit none
 
   ! Arguments
   type(psb_sspmat_type), intent(inout)    :: a
-  type(psb_desc_type), intent(in)         :: desc_a
+  type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
   type(amg_sml_parms), intent(inout)      :: parms
   type(psb_lsspmat_type), intent(inout)   :: t_prol
@@ -134,6 +141,8 @@ subroutine amg_s_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
 
+#if !defined(SERIAL_MPI)
+
   call a%mv_to(acsr)
 
   call  amg_s_parmatch_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,&
@@ -149,7 +158,7 @@ subroutine amg_s_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done spmm_bld '
-
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_s_parmatch_unsmth_bld.F90

@@ -1,14 +1,14 @@
 !
 !
-!                             AMG4PSBLAS  version 2.2
-!    MultiLevel Domain Decomposition Parallel Preconditioners Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
 !
-!    (C) Copyright 2008-2018
+!    (C) Copyright 2021
 !
 !        Salvatore Filippone
 !        Pasqua D'Ambra
-!        Daniela di Serafino
+!        Fabio Durastante
 !
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
@@ -34,7 +34,6 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-!
 ! File: amg_s_parmatch_unsmth_bld.F90
 !
 ! Subroutine: amg_s_parmatch_unsmth_bld
@@ -108,7 +107,11 @@ subroutine amg_s_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
   use amg_base_prec_type
   use amg_s_inner_mod
   use amg_s_base_aggregator_mod
+#if defined(SERIAL_MPI)
+    use amg_s_parmatch_aggregator_mod
+#else
   use amg_s_parmatch_aggregator_mod, amg_protect_name => amg_s_parmatch_unsmth_bld
+#endif
   implicit none
 
   ! Arguments
@@ -157,6 +160,7 @@ subroutine amg_s_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
 
   call psb_info(ictxt, me, np)
 
+#if !defined(SERIAL_MPI)
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
   ncol  = desc_a%get_local_cols()
@@ -224,7 +228,7 @@ subroutine amg_s_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
     goto 9999
   end if
 
-
+#endif
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_s_symdec_aggregator_tprol.f90

@@ -86,8 +86,8 @@ subroutine  amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
   class(amg_s_symdec_aggregator_type), target, intent(inout) :: ag
   type(amg_sml_parms), intent(inout)  :: parms
   type(amg_saggr_data), intent(in)    :: ag_data
-  type(psb_sspmat_type), intent(in)   :: a
-  type(psb_desc_type), intent(in)     :: desc_a
+  type(psb_sspmat_type), intent(inout) :: a
+  type(psb_desc_type), intent(inout)   :: desc_a
   integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
   type(psb_lsspmat_type), intent(out)  :: op_prol
   integer(psb_ipk_), intent(out)      :: info

amgprec/impl/aggregator/amg_saggrmat_minnrg_bld.f90

@@ -105,7 +105,7 @@
 !
 !
 subroutine amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,info)
+     & ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_s_inner_mod, amg_protect_name => amg_saggrmat_minnrg_bld
@@ -117,8 +117,8 @@ subroutine amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
   type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
   type(amg_sml_parms), intent(inout)         :: parms 
-  type(psb_lsspmat_type), intent(inout)       :: op_prol
-  type(psb_lsspmat_type), intent(out)         :: ac,op_restr
+  type(psb_lsspmat_type), intent(inout)       :: t_prol
+  type(psb_sspmat_type), intent(inout)       :: op_prol, ac,op_restr
   type(psb_desc_type), intent(inout)            :: desc_ac
   integer(psb_ipk_), intent(out)                :: info
 
@@ -171,6 +171,8 @@ subroutine amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   filter_mat = (parms%aggr_filter == amg_filter_mat_)
 
+  !NEEDS TO BE REWORKED !!
+  
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
@@ -183,361 +185,361 @@ subroutine amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
     goto 9999      
   end if
 
-  ! Get the diagonal D
-  adiag =  a%get_diag(info)
-  if (info == psb_success_) &
-       & call psb_realloc(ncol,adiag,info)    
-  if (info == psb_success_) &
-       & call psb_halo(adiag,desc_a,info)
-  if (info == psb_success_) call a%cp_to_l(la)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
-    goto 9999
-  end if
-
-  do i=1,size(adiag)
-    if (adiag(i) /= szero) then
-      adinv(i) = sone / adiag(i)
-    else
-      adinv(i) = sone
-    end if
-  end do
-
-
-
-  ! 1. Allocate Ptilde in sparse matrix form 
-  call op_prol%mv_to(tmpcoo)
-  call ptilde%mv_from(tmpcoo)
-  call ptilde%cscnv(info,type='csr')
-
-  if (info == psb_success_) call la%cscnv(am3,info,type='csr',dupl=psb_dupl_add_)
-  if (info == psb_success_) call la%cscnv(da,info,type='csr',dupl=psb_dupl_add_)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
-    goto 9999
-  end if
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & ' Initial copies done.'
-
-  call da%scal(adinv,info)
-
-  call psb_spspmm(da,ptilde,dap,info)
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
-    goto 9999
-  end if
-
-  call dap%clone(atmp,info)
-
-  call psb_sphalo(atmp,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
-  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-  call psb_spspmm(da,atmp,dadap,info)
-  call atmp%free()
-
-  !  !$  write(0,*) 'Columns of AP',psb_sp_get_ncols(ap)
-  !  !$  write(0,*) 'Columns of ADAP',psb_sp_get_ncols(adap)
-  call dap%mv_to(csc_dap)
-  call dadap%mv_to(csc_dadap)
-
-  call csc_mat_col_prod(csc_dap,csc_dadap,omp,info)
-  call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info)
-  call psb_sum(ctxt,omp)
-  call psb_sum(ctxt,oden)
-  ! !$  write(0,*) trim(name),' OMP :',omp
-  ! !$  write(0,*) trim(name),' ODEN:',oden
-
-  omp = omp/oden
-
-  ! !$  write(0,*) 'Check on output prolongator ',omp(1:min(size(omp),10))
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done NUMBMM 1'
-
-  call am3%mv_to(acsr3)
-  ! Compute omega_int
-  ommx = szero
-  do i=1, ncol
-    if (ilaggr(i) >0) then 
-      omi(i) = omp(ilaggr(i))
-    else
-      omi(i) = szero
-    end if
-    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
-  end do
-  ! Compute omega_fine
-  do i=1, nrow
-    omf(i) = ommx
-    do j=acsr3%irp(i),acsr3%irp(i+1)-1
-      if(abs(omi(acsr3%ja(j))) .lt. abs(omf(i))) omf(i)=omi(acsr3%ja(j))
-    end do
-!!$    if(min(real(omf(i)),aimag(omf(i))) < szero) omf(i) = szero
-    if(psb_minreal(omf(i)) < szero) omf(i) = szero
-  end do
-
-  omf(1:nrow) = omf(1:nrow) * adinv(1:nrow)
-
-  if (filter_mat) then
-    !
-    ! Build the filtered matrix Af from A
-    ! 
-    call la%cscnv(acsrf,info,dupl=psb_dupl_add_)
-
-    do i=1,nrow
-      tmp = szero
-      jd  = -1 
-      do j=acsrf%irp(i),acsrf%irp(i+1)-1
-        if (acsrf%ja(j) == i) jd = j 
-        if (abs(acsrf%val(j)) < theta*sqrt(abs(adiag(i)*adiag(acsrf%ja(j))))) then
-          tmp=tmp+acsrf%val(j)
-          acsrf%val(j)=szero
-        endif
-      enddo
-      if (jd == -1) then 
-        write(0,*) 'Wrong input: we need the diagonal!!!!', i
-      else
-        acsrf%val(jd)=acsrf%val(jd)-tmp
-      end if
-    enddo
-    ! Take out zeroed terms 
-    call acsrf%clean_zeros(info)
-
-    !
-    ! Build the smoothed prolongator using the filtered matrix
-    ! 
-    do i=1,acsrf%get_nrows()
-      do j=acsrf%irp(i),acsrf%irp(i+1)-1
-        if (acsrf%ja(j) == i) then 
-          acsrf%val(j) = sone - omf(i)*acsrf%val(j) 
-        else
-          acsrf%val(j) = - omf(i)*acsrf%val(j) 
-        end if
-      end do
-    end do
-
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done gather, going for SYMBMM 1'
-
-    call af%mv_from(acsrf)
-    !
-    ! op_prol = (I-w*D*Af)Ptilde
-    ! Doing it this way means to consider diag(Af_i)
-    ! 
-    !
-    call psb_spspmm(af,ptilde,op_prol,info)
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done SPSPMM 1'
-  else
-    !
-    ! Build the smoothed prolongator using the original matrix
-    !
-    do i=1,acsr3%get_nrows()
-      do j=acsr3%irp(i),acsr3%irp(i+1)-1
-        if (acsr3%ja(j) == i) then 
-          acsr3%val(j) = sone - omf(i)*acsr3%val(j) 
-        else
-          acsr3%val(j) = - omf(i)*acsr3%val(j) 
-        end if
-      end do
-    end do
-
-    call am3%mv_from(acsr3)
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done gather, going for SYMBMM 1'
-    !
-    ! 
-    ! op_prol = (I-w*D*A)Ptilde
-    ! 
-    !
-    call psb_spspmm(am3,ptilde,op_prol,info)
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done NUMBMM 1'
-
-  end if
-
-
-  !
-  ! Ok, let's start over with the restrictor
-  ! 
-  call ptilde%transc(rtilde)
-  call la%cscnv(atmp,info,type='csr')
-  call psb_sphalo(atmp,desc_a,am4,info,&
-       & colcnv=.true.,rowscale=.true.)
-  nrt  = am4%get_nrows() 
-  call am4%csclip(atmp2,info,lone,nrt,lone,ncol)
-  call atmp2%cscnv(info,type='CSR')
-  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=atmp2)      
-  call am4%free()
-  call atmp2%free()
-
-  ! This is to compute the transpose. It ONLY works if the
-  ! original A has a symmetric pattern.
-  call atmp%transc(atmp2) 
-  call atmp2%csclip(dat,info,lone,nrow,lone,ncol)
-  call dat%cscnv(info,type='csr')
-  call dat%scal(adinv,info)
-
-  ! Now for the product. 
-  call psb_spspmm(dat,ptilde,datp,info)
-
-  call datp%clone(atmp2,info)
-  call psb_sphalo(atmp2,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
-  if (info == psb_success_) call psb_rwextd(ncol,atmp2,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-
-  call psb_symbmm(dat,atmp2,datdatp,info)
-  call psb_numbmm(dat,atmp2,datdatp)
-  call atmp2%free()
-
-  call datp%mv_to(csc_datp)    
-  call datdatp%mv_to(csc_datdatp)    
-
-  call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info)
-  call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info)
-  call psb_sum(ctxt,omp)
-  call psb_sum(ctxt,oden)
-
-
-  ! !$  write(debug_unit,*) trim(name),' OMP_R :',omp
-  ! ! $  write(debug_unit,*) trim(name),' ODEN_R:',oden
-  omp = omp/oden
-  ! !$  write(0,*) 'Check on output restrictor',omp(1:min(size(omp),10))
-  ! Compute omega_int
-  ommx = szero
-  do i=1, ncol
-    if (ilaggr(i) >0) then 
-      omi(i) = omp(ilaggr(i))
-    else
-      omi(i) = szero
-    end if
-    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
-  end do
-  ! Compute omega_fine
-  ! Going over the columns of atmp means going over the rows
-  ! of A^T. Hopefully ;-) 
-  call atmp%cp_to(acsc)
-
-  do i=1, nrow
-    omf(i) = ommx
-    do j= acsc%icp(i),acsc%icp(i+1)-1
-      if(abs(omi(acsc%ia(j))) .lt. abs(omf(i))) omf(i)=omi(acsc%ia(j))
-    end do
-!!$    if(min(real(omf(i)),aimag(omf(i))) < szero) omf(i) = szero
-    if(psb_minreal(omf(i)) < szero) omf(i) = szero
-  end do
-  omf(1:nrow) = omf(1:nrow)*adinv(1:nrow)
-  call psb_halo(omf,desc_a,info)
-  call acsc%free() 
-
-
-  call atmp%mv_to(acsr1)
-
-  do i=1,acsr1%get_nrows()
-    do j=acsr1%irp(i),acsr1%irp(i+1)-1
-      if (acsr1%ja(j) == i) then 
-        acsr1%val(j) = sone - acsr1%val(j)*omf(acsr1%ja(j))
-      else
-        acsr1%val(j) =      - acsr1%val(j)*omf(acsr1%ja(j))
-      end if
-    end do
-  end do
-  call atmp%mv_from(acsr1)
-
-  call rtilde%mv_to(tmpcoo)
-  nzl = tmpcoo%get_nzeros()
-  i=0
-  do k=1, nzl
-    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
-      i = i+1
-      tmpcoo%val(i) = tmpcoo%val(k)
-      tmpcoo%ia(i)  = tmpcoo%ia(k)
-      tmpcoo%ja(i)  = tmpcoo%ja(k)
-    end if
-  end do
-  call tmpcoo%set_nzeros(i)
-  call rtilde%mv_from(tmpcoo)
-  call rtilde%cscnv(info,type='csr')
-
-  call psb_spspmm(rtilde,atmp,op_restr,info)
-
-  !
-  ! Now we have to gather the halo of op_prol, and add it to itself
-  ! to multiply it by A,
-  !
-  call op_prol%clone(tmp_prol,info) 
-  if (info == psb_success_) call psb_sphalo(tmp_prol,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.)
-  if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol')
-    goto 9999
-  end if
-
-  !
-  ! Now we have to fix this.  The only rows of B that are correct 
-  ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
-  !
-  call op_restr%mv_to(tmpcoo)
-
-  nzl = tmpcoo%get_nzeros()
-  i=0
-  do k=1, nzl
-    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
-      i = i+1
-      tmpcoo%val(i) = tmpcoo%val(k)
-      tmpcoo%ia(i)  = tmpcoo%ia(k)
-      tmpcoo%ja(i)  = tmpcoo%ja(k)
-    end if
-  end do
-  call tmpcoo%set_nzeros(i)
-  call op_restr%mv_from(tmpcoo)
-  call op_restr%cscnv(info,type='csr')
-
-
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'starting sphalo/ rwxtd'
-
-  call psb_spspmm(la,tmp_prol,am3,info)
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done SPSPMM 2'
-
-  call psb_sphalo(am3,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.)
-  if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,&
-         & a_err='Extend am3')
-    goto 9999
-  end if
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done sphalo/ rwxtd'
-
-  call psb_spspmm(op_restr,am3,ac,info)
-  if (info == psb_success_) call am3%free()
-  if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_)
-
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,&
-         &a_err='Build ac = op_restr x am3')
-    goto 9999
-  end if
+!!$  ! Get the diagonal D
+!!$  adiag =  a%get_diag(info)
+!!$  if (info == psb_success_) &
+!!$       & call psb_realloc(ncol,adiag,info)    
+!!$  if (info == psb_success_) &
+!!$       & call psb_halo(adiag,desc_a,info)
+!!$  if (info == psb_success_) call a%cp_to_l(la)
+!!$  if (info /= psb_success_) then
+!!$    call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
+!!$    goto 9999
+!!$  end if
+!!$
+!!$  do i=1,size(adiag)
+!!$    if (adiag(i) /= szero) then
+!!$      adinv(i) = sone / adiag(i)
+!!$    else
+!!$      adinv(i) = sone
+!!$    end if
+!!$  end do
+!!$
+!!$
+!!$
+!!$  ! 1. Allocate Ptilde in sparse matrix form 
+!!$  call op_prol%mv_to(tmpcoo)
+!!$  call ptilde%mv_from(tmpcoo)
+!!$  call ptilde%cscnv(info,type='csr')
+!!$
+!!$  if (info == psb_success_) call la%cscnv(am3,info,type='csr',dupl=psb_dupl_add_)
+!!$  if (info == psb_success_) call la%cscnv(da,info,type='csr',dupl=psb_dupl_add_)
+!!$  if (info /= psb_success_) then
+!!$    call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
+!!$    goto 9999
+!!$  end if
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & ' Initial copies done.'
+!!$
+!!$  call da%scal(adinv,info)
+!!$
+!!$  call psb_spspmm(da,ptilde,dap,info)
+!!$
+!!$  if(info /= psb_success_) then
+!!$    call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
+!!$    goto 9999
+!!$  end if
+!!$
+!!$  call dap%clone(atmp,info)
+!!$
+!!$  call psb_sphalo(atmp,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
+!!$  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$  call psb_spspmm(da,atmp,dadap,info)
+!!$  call atmp%free()
+!!$
+!!$  !  !$  write(0,*) 'Columns of AP',psb_sp_get_ncols(ap)
+!!$  !  !$  write(0,*) 'Columns of ADAP',psb_sp_get_ncols(adap)
+!!$  call dap%mv_to(csc_dap)
+!!$  call dadap%mv_to(csc_dadap)
+!!$
+!!$  call csc_mat_col_prod(csc_dap,csc_dadap,omp,info)
+!!$  call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info)
+!!$  call psb_sum(ctxt,omp)
+!!$  call psb_sum(ctxt,oden)
+!!$  ! !$  write(0,*) trim(name),' OMP :',omp
+!!$  ! !$  write(0,*) trim(name),' ODEN:',oden
+!!$
+!!$  omp = omp/oden
+!!$
+!!$  ! !$  write(0,*) 'Check on output prolongator ',omp(1:min(size(omp),10))
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'Done NUMBMM 1'
+!!$
+!!$  call am3%mv_to(acsr3)
+!!$  ! Compute omega_int
+!!$  ommx = szero
+!!$  do i=1, ncol
+!!$    if (ilaggr(i) >0) then 
+!!$      omi(i) = omp(ilaggr(i))
+!!$    else
+!!$      omi(i) = szero
+!!$    end if
+!!$    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
+!!$  end do
+!!$  ! Compute omega_fine
+!!$  do i=1, nrow
+!!$    omf(i) = ommx
+!!$    do j=acsr3%irp(i),acsr3%irp(i+1)-1
+!!$      if(abs(omi(acsr3%ja(j))) .lt. abs(omf(i))) omf(i)=omi(acsr3%ja(j))
+!!$    end do
+!!$ ! !     if(min(real(omf(i)),aimag(omf(i))) < szero) omf(i) = szero
+!!$    if(psb_minreal(omf(i)) < szero) omf(i) = szero
+!!$  end do
+!!$
+!!$  omf(1:nrow) = omf(1:nrow) * adinv(1:nrow)
+!!$
+!!$  if (filter_mat) then
+!!$    !
+!!$    ! Build the filtered matrix Af from A
+!!$    ! 
+!!$    call la%cscnv(acsrf,info,dupl=psb_dupl_add_)
+!!$
+!!$    do i=1,nrow
+!!$      tmp = szero
+!!$      jd  = -1 
+!!$      do j=acsrf%irp(i),acsrf%irp(i+1)-1
+!!$        if (acsrf%ja(j) == i) jd = j 
+!!$        if (abs(acsrf%val(j)) < theta*sqrt(abs(adiag(i)*adiag(acsrf%ja(j))))) then
+!!$          tmp=tmp+acsrf%val(j)
+!!$          acsrf%val(j)=szero
+!!$        endif
+!!$      enddo
+!!$      if (jd == -1) then 
+!!$        write(0,*) 'Wrong input: we need the diagonal!!!!', i
+!!$      else
+!!$        acsrf%val(jd)=acsrf%val(jd)-tmp
+!!$      end if
+!!$    enddo
+!!$    ! Take out zeroed terms 
+!!$    call acsrf%clean_zeros(info)
+!!$
+!!$    !
+!!$    ! Build the smoothed prolongator using the filtered matrix
+!!$    ! 
+!!$    do i=1,acsrf%get_nrows()
+!!$      do j=acsrf%irp(i),acsrf%irp(i+1)-1
+!!$        if (acsrf%ja(j) == i) then 
+!!$          acsrf%val(j) = sone - omf(i)*acsrf%val(j) 
+!!$        else
+!!$          acsrf%val(j) = - omf(i)*acsrf%val(j) 
+!!$        end if
+!!$      end do
+!!$    end do
+!!$
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done gather, going for SYMBMM 1'
+!!$
+!!$    call af%mv_from(acsrf)
+!!$    !
+!!$    ! op_prol = (I-w*D*Af)Ptilde
+!!$    ! Doing it this way means to consider diag(Af_i)
+!!$    ! 
+!!$    !
+!!$    call psb_spspmm(af,ptilde,op_prol,info)
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done SPSPMM 1'
+!!$  else
+!!$    !
+!!$    ! Build the smoothed prolongator using the original matrix
+!!$    !
+!!$    do i=1,acsr3%get_nrows()
+!!$      do j=acsr3%irp(i),acsr3%irp(i+1)-1
+!!$        if (acsr3%ja(j) == i) then 
+!!$          acsr3%val(j) = sone - omf(i)*acsr3%val(j) 
+!!$        else
+!!$          acsr3%val(j) = - omf(i)*acsr3%val(j) 
+!!$        end if
+!!$      end do
+!!$    end do
+!!$
+!!$    call am3%mv_from(acsr3)
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done gather, going for SYMBMM 1'
+!!$    !
+!!$    ! 
+!!$    ! op_prol = (I-w*D*A)Ptilde
+!!$    ! 
+!!$    !
+!!$    call psb_spspmm(am3,ptilde,op_prol,info)
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done NUMBMM 1'
+!!$
+!!$  end if
+!!$
+!!$
+!!$  !
+!!$  ! Ok, let's start over with the restrictor
+!!$  ! 
+!!$  call ptilde%transc(rtilde)
+!!$  call la%cscnv(atmp,info,type='csr')
+!!$  call psb_sphalo(atmp,desc_a,am4,info,&
+!!$       & colcnv=.true.,rowscale=.true.)
+!!$  nrt  = am4%get_nrows() 
+!!$  call am4%csclip(atmp2,info,lone,nrt,lone,ncol)
+!!$  call atmp2%cscnv(info,type='CSR')
+!!$  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=atmp2)      
+!!$  call am4%free()
+!!$  call atmp2%free()
+!!$
+!!$  ! This is to compute the transpose. It ONLY works if the
+!!$  ! original A has a symmetric pattern.
+!!$  call atmp%transc(atmp2) 
+!!$  call atmp2%csclip(dat,info,lone,nrow,lone,ncol)
+!!$  call dat%cscnv(info,type='csr')
+!!$  call dat%scal(adinv,info)
+!!$
+!!$  ! Now for the product. 
+!!$  call psb_spspmm(dat,ptilde,datp,info)
+!!$
+!!$  call datp%clone(atmp2,info)
+!!$  call psb_sphalo(atmp2,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
+!!$  if (info == psb_success_) call psb_rwextd(ncol,atmp2,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$
+!!$  call psb_symbmm(dat,atmp2,datdatp,info)
+!!$  call psb_numbmm(dat,atmp2,datdatp)
+!!$  call atmp2%free()
+!!$
+!!$  call datp%mv_to(csc_datp)    
+!!$  call datdatp%mv_to(csc_datdatp)    
+!!$
+!!$  call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info)
+!!$  call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info)
+!!$  call psb_sum(ctxt,omp)
+!!$  call psb_sum(ctxt,oden)
+!!$
+!!$
+!!$  ! !$  write(debug_unit,*) trim(name),' OMP_R :',omp
+!!$  ! ! $  write(debug_unit,*) trim(name),' ODEN_R:',oden
+!!$  omp = omp/oden
+!!$  ! !$  write(0,*) 'Check on output restrictor',omp(1:min(size(omp),10))
+!!$  ! Compute omega_int
+!!$  ommx = szero
+!!$  do i=1, ncol
+!!$    if (ilaggr(i) >0) then 
+!!$      omi(i) = omp(ilaggr(i))
+!!$    else
+!!$      omi(i) = szero
+!!$    end if
+!!$    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
+!!$  end do
+!!$  ! Compute omega_fine
+!!$  ! Going over the columns of atmp means going over the rows
+!!$  ! of A^T. Hopefully ;-) 
+!!$  call atmp%cp_to(acsc)
+!!$
+!!$  do i=1, nrow
+!!$    omf(i) = ommx
+!!$    do j= acsc%icp(i),acsc%icp(i+1)-1
+!!$      if(abs(omi(acsc%ia(j))) .lt. abs(omf(i))) omf(i)=omi(acsc%ia(j))
+!!$    end do
+!!$ ! !    if(min(real(omf(i)),aimag(omf(i))) < szero) omf(i) = szero
+!!$    if(psb_minreal(omf(i)) < szero) omf(i) = szero
+!!$  end do
+!!$  omf(1:nrow) = omf(1:nrow)*adinv(1:nrow)
+!!$  call psb_halo(omf,desc_a,info)
+!!$  call acsc%free() 
+!!$
+!!$
+!!$  call atmp%mv_to(acsr1)
+!!$
+!!$  do i=1,acsr1%get_nrows()
+!!$    do j=acsr1%irp(i),acsr1%irp(i+1)-1
+!!$      if (acsr1%ja(j) == i) then 
+!!$        acsr1%val(j) = sone - acsr1%val(j)*omf(acsr1%ja(j))
+!!$      else
+!!$        acsr1%val(j) =      - acsr1%val(j)*omf(acsr1%ja(j))
+!!$      end if
+!!$    end do
+!!$  end do
+!!$  call atmp%mv_from(acsr1)
+!!$
+!!$  call rtilde%mv_to(tmpcoo)
+!!$  nzl = tmpcoo%get_nzeros()
+!!$  i=0
+!!$  do k=1, nzl
+!!$    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
+!!$      i = i+1
+!!$      tmpcoo%val(i) = tmpcoo%val(k)
+!!$      tmpcoo%ia(i)  = tmpcoo%ia(k)
+!!$      tmpcoo%ja(i)  = tmpcoo%ja(k)
+!!$    end if
+!!$  end do
+!!$  call tmpcoo%set_nzeros(i)
+!!$  call rtilde%mv_from(tmpcoo)
+!!$  call rtilde%cscnv(info,type='csr')
+!!$
+!!$  call psb_spspmm(rtilde,atmp,op_restr,info)
+!!$
+!!$  !
+!!$  ! Now we have to gather the halo of op_prol, and add it to itself
+!!$  ! to multiply it by A,
+!!$  !
+!!$  call op_prol%clone(tmp_prol,info) 
+!!$  if (info == psb_success_) call psb_sphalo(tmp_prol,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.)
+!!$  if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$  if(info /= psb_success_) then
+!!$    call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol')
+!!$    goto 9999
+!!$  end if
+!!$
+!!$  !
+!!$  ! Now we have to fix this.  The only rows of B that are correct 
+!!$  ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
+!!$  !
+!!$  call op_restr%mv_to(tmpcoo)
+!!$
+!!$  nzl = tmpcoo%get_nzeros()
+!!$  i=0
+!!$  do k=1, nzl
+!!$    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
+!!$      i = i+1
+!!$      tmpcoo%val(i) = tmpcoo%val(k)
+!!$      tmpcoo%ia(i)  = tmpcoo%ia(k)
+!!$      tmpcoo%ja(i)  = tmpcoo%ja(k)
+!!$    end if
+!!$  end do
+!!$  call tmpcoo%set_nzeros(i)
+!!$  call op_restr%mv_from(tmpcoo)
+!!$  call op_restr%cscnv(info,type='csr')
+!!$
+!!$
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'starting sphalo/ rwxtd'
+!!$
+!!$  call psb_spspmm(la,tmp_prol,am3,info)
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'Done SPSPMM 2'
+!!$
+!!$  call psb_sphalo(am3,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.)
+!!$  if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$  if(info /= psb_success_) then
+!!$    call psb_errpush(psb_err_internal_error_,name,&
+!!$         & a_err='Extend am3')
+!!$    goto 9999
+!!$  end if
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'Done sphalo/ rwxtd'
+!!$
+!!$  call psb_spspmm(op_restr,am3,ac,info)
+!!$  if (info == psb_success_) call am3%free()
+!!$  if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_)
+!!$
+!!$  if (info /= psb_success_) then
+!!$    call psb_errpush(psb_err_internal_error_,name,&
+!!$         &a_err='Build ac = op_restr x am3')
+!!$    goto 9999
+!!$  end if
 
 
 

amgprec/impl/aggregator/amg_saggrmat_smth_bld.f90

@@ -116,7 +116,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
   type(amg_sml_parms), intent(inout)      :: parms 
-  type(psb_sspmat_type), intent(out)      :: op_prol,ac,op_restr
+  type(psb_sspmat_type), intent(inout)      :: op_prol,ac,op_restr
   type(psb_lsspmat_type), intent(inout)    :: t_prol
   type(psb_desc_type), intent(inout)       :: desc_ac
   integer(psb_ipk_), intent(out)           :: info

amgprec/impl/aggregator/amg_z_dec_aggregator_tprol.f90

@@ -83,8 +83,8 @@ subroutine  amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
   class(amg_z_dec_aggregator_type), target, intent(inout) :: ag
   type(amg_dml_parms), intent(inout)  :: parms
   type(amg_daggr_data), intent(in)    :: ag_data
-  type(psb_zspmat_type), intent(in)   :: a
-  type(psb_desc_type), intent(in)     :: desc_a
+  type(psb_zspmat_type), intent(inout) :: a
+  type(psb_desc_type), intent(inout)    :: desc_a
   integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
   type(psb_lzspmat_type), intent(out)  :: t_prol
   integer(psb_ipk_), intent(out)      :: info

amgprec/impl/aggregator/amg_z_symdec_aggregator_tprol.f90

@@ -86,8 +86,8 @@ subroutine  amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
   class(amg_z_symdec_aggregator_type), target, intent(inout) :: ag
   type(amg_dml_parms), intent(inout)  :: parms
   type(amg_daggr_data), intent(in)    :: ag_data
-  type(psb_zspmat_type), intent(in)   :: a
-  type(psb_desc_type), intent(in)     :: desc_a
+  type(psb_zspmat_type), intent(inout) :: a
+  type(psb_desc_type), intent(inout)   :: desc_a
   integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
   type(psb_lzspmat_type), intent(out)  :: op_prol
   integer(psb_ipk_), intent(out)      :: info

amgprec/impl/aggregator/amg_zaggrmat_minnrg_bld.f90

@@ -105,7 +105,7 @@
 !
 !
 subroutine amg_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,info)
+     & ac,desc_ac,op_prol,op_restr,t_prol,info)
   use psb_base_mod
   use amg_base_prec_type
   use amg_z_inner_mod, amg_protect_name => amg_zaggrmat_minnrg_bld
@@ -117,8 +117,8 @@ subroutine amg_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
   type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
   type(amg_dml_parms), intent(inout)         :: parms 
-  type(psb_lzspmat_type), intent(inout)       :: op_prol
-  type(psb_lzspmat_type), intent(out)         :: ac,op_restr
+  type(psb_lzspmat_type), intent(inout)       :: t_prol
+  type(psb_zspmat_type), intent(inout)       :: op_prol, ac,op_restr
   type(psb_desc_type), intent(inout)            :: desc_ac
   integer(psb_ipk_), intent(out)                :: info
 
@@ -171,6 +171,8 @@ subroutine amg_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
 
   filter_mat = (parms%aggr_filter == amg_filter_mat_)
 
+  !NEEDS TO BE REWORKED !!
+  
   ! naggr: number of local aggregates
   ! nrow: local rows. 
   ! 
@@ -183,361 +185,361 @@ subroutine amg_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
     goto 9999      
   end if
 
-  ! Get the diagonal D
-  adiag =  a%get_diag(info)
-  if (info == psb_success_) &
-       & call psb_realloc(ncol,adiag,info)    
-  if (info == psb_success_) &
-       & call psb_halo(adiag,desc_a,info)
-  if (info == psb_success_) call a%cp_to_l(la)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
-    goto 9999
-  end if
-
-  do i=1,size(adiag)
-    if (adiag(i) /= zzero) then
-      adinv(i) = zone / adiag(i)
-    else
-      adinv(i) = zone
-    end if
-  end do
-
-
-
-  ! 1. Allocate Ptilde in sparse matrix form 
-  call op_prol%mv_to(tmpcoo)
-  call ptilde%mv_from(tmpcoo)
-  call ptilde%cscnv(info,type='csr')
-
-  if (info == psb_success_) call la%cscnv(am3,info,type='csr',dupl=psb_dupl_add_)
-  if (info == psb_success_) call la%cscnv(da,info,type='csr',dupl=psb_dupl_add_)
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
-    goto 9999
-  end if
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & ' Initial copies done.'
-
-  call da%scal(adinv,info)
-
-  call psb_spspmm(da,ptilde,dap,info)
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
-    goto 9999
-  end if
-
-  call dap%clone(atmp,info)
-
-  call psb_sphalo(atmp,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
-  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-  call psb_spspmm(da,atmp,dadap,info)
-  call atmp%free()
-
-  !  !$  write(0,*) 'Columns of AP',psb_sp_get_ncols(ap)
-  !  !$  write(0,*) 'Columns of ADAP',psb_sp_get_ncols(adap)
-  call dap%mv_to(csc_dap)
-  call dadap%mv_to(csc_dadap)
-
-  call csc_mat_col_prod(csc_dap,csc_dadap,omp,info)
-  call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info)
-  call psb_sum(ctxt,omp)
-  call psb_sum(ctxt,oden)
-  ! !$  write(0,*) trim(name),' OMP :',omp
-  ! !$  write(0,*) trim(name),' ODEN:',oden
-
-  omp = omp/oden
-
-  ! !$  write(0,*) 'Check on output prolongator ',omp(1:min(size(omp),10))
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done NUMBMM 1'
-
-  call am3%mv_to(acsr3)
-  ! Compute omega_int
-  ommx = zzero
-  do i=1, ncol
-    if (ilaggr(i) >0) then 
-      omi(i) = omp(ilaggr(i))
-    else
-      omi(i) = zzero
-    end if
-    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
-  end do
-  ! Compute omega_fine
-  do i=1, nrow
-    omf(i) = ommx
-    do j=acsr3%irp(i),acsr3%irp(i+1)-1
-      if(abs(omi(acsr3%ja(j))) .lt. abs(omf(i))) omf(i)=omi(acsr3%ja(j))
-    end do
-!!$    if(min(real(omf(i)),aimag(omf(i))) < dzero) omf(i) = zzero
-    if(psb_minreal(omf(i)) < dzero) omf(i) = zzero
-  end do
-
-  omf(1:nrow) = omf(1:nrow) * adinv(1:nrow)
-
-  if (filter_mat) then
-    !
-    ! Build the filtered matrix Af from A
-    ! 
-    call la%cscnv(acsrf,info,dupl=psb_dupl_add_)
-
-    do i=1,nrow
-      tmp = zzero
-      jd  = -1 
-      do j=acsrf%irp(i),acsrf%irp(i+1)-1
-        if (acsrf%ja(j) == i) jd = j 
-        if (abs(acsrf%val(j)) < theta*sqrt(abs(adiag(i)*adiag(acsrf%ja(j))))) then
-          tmp=tmp+acsrf%val(j)
-          acsrf%val(j)=zzero
-        endif
-      enddo
-      if (jd == -1) then 
-        write(0,*) 'Wrong input: we need the diagonal!!!!', i
-      else
-        acsrf%val(jd)=acsrf%val(jd)-tmp
-      end if
-    enddo
-    ! Take out zeroed terms 
-    call acsrf%clean_zeros(info)
-
-    !
-    ! Build the smoothed prolongator using the filtered matrix
-    ! 
-    do i=1,acsrf%get_nrows()
-      do j=acsrf%irp(i),acsrf%irp(i+1)-1
-        if (acsrf%ja(j) == i) then 
-          acsrf%val(j) = zone - omf(i)*acsrf%val(j) 
-        else
-          acsrf%val(j) = - omf(i)*acsrf%val(j) 
-        end if
-      end do
-    end do
-
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done gather, going for SYMBMM 1'
-
-    call af%mv_from(acsrf)
-    !
-    ! op_prol = (I-w*D*Af)Ptilde
-    ! Doing it this way means to consider diag(Af_i)
-    ! 
-    !
-    call psb_spspmm(af,ptilde,op_prol,info)
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done SPSPMM 1'
-  else
-    !
-    ! Build the smoothed prolongator using the original matrix
-    !
-    do i=1,acsr3%get_nrows()
-      do j=acsr3%irp(i),acsr3%irp(i+1)-1
-        if (acsr3%ja(j) == i) then 
-          acsr3%val(j) = zone - omf(i)*acsr3%val(j) 
-        else
-          acsr3%val(j) = - omf(i)*acsr3%val(j) 
-        end if
-      end do
-    end do
-
-    call am3%mv_from(acsr3)
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done gather, going for SYMBMM 1'
-    !
-    ! 
-    ! op_prol = (I-w*D*A)Ptilde
-    ! 
-    !
-    call psb_spspmm(am3,ptilde,op_prol,info)
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done NUMBMM 1'
-
-  end if
-
-
-  !
-  ! Ok, let's start over with the restrictor
-  ! 
-  call ptilde%transc(rtilde)
-  call la%cscnv(atmp,info,type='csr')
-  call psb_sphalo(atmp,desc_a,am4,info,&
-       & colcnv=.true.,rowscale=.true.)
-  nrt  = am4%get_nrows() 
-  call am4%csclip(atmp2,info,lone,nrt,lone,ncol)
-  call atmp2%cscnv(info,type='CSR')
-  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=atmp2)      
-  call am4%free()
-  call atmp2%free()
-
-  ! This is to compute the transpose. It ONLY works if the
-  ! original A has a symmetric pattern.
-  call atmp%transc(atmp2) 
-  call atmp2%csclip(dat,info,lone,nrow,lone,ncol)
-  call dat%cscnv(info,type='csr')
-  call dat%scal(adinv,info)
-
-  ! Now for the product. 
-  call psb_spspmm(dat,ptilde,datp,info)
-
-  call datp%clone(atmp2,info)
-  call psb_sphalo(atmp2,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
-  if (info == psb_success_) call psb_rwextd(ncol,atmp2,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-
-  call psb_symbmm(dat,atmp2,datdatp,info)
-  call psb_numbmm(dat,atmp2,datdatp)
-  call atmp2%free()
-
-  call datp%mv_to(csc_datp)    
-  call datdatp%mv_to(csc_datdatp)    
-
-  call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info)
-  call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info)
-  call psb_sum(ctxt,omp)
-  call psb_sum(ctxt,oden)
-
-
-  ! !$  write(debug_unit,*) trim(name),' OMP_R :',omp
-  ! ! $  write(debug_unit,*) trim(name),' ODEN_R:',oden
-  omp = omp/oden
-  ! !$  write(0,*) 'Check on output restrictor',omp(1:min(size(omp),10))
-  ! Compute omega_int
-  ommx = zzero
-  do i=1, ncol
-    if (ilaggr(i) >0) then 
-      omi(i) = omp(ilaggr(i))
-    else
-      omi(i) = zzero
-    end if
-    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
-  end do
-  ! Compute omega_fine
-  ! Going over the columns of atmp means going over the rows
-  ! of A^T. Hopefully ;-) 
-  call atmp%cp_to(acsc)
-
-  do i=1, nrow
-    omf(i) = ommx
-    do j= acsc%icp(i),acsc%icp(i+1)-1
-      if(abs(omi(acsc%ia(j))) .lt. abs(omf(i))) omf(i)=omi(acsc%ia(j))
-    end do
-!!$    if(min(real(omf(i)),aimag(omf(i))) < dzero) omf(i) = zzero
-    if(psb_minreal(omf(i)) < dzero) omf(i) = zzero
-  end do
-  omf(1:nrow) = omf(1:nrow)*adinv(1:nrow)
-  call psb_halo(omf,desc_a,info)
-  call acsc%free() 
-
-
-  call atmp%mv_to(acsr1)
-
-  do i=1,acsr1%get_nrows()
-    do j=acsr1%irp(i),acsr1%irp(i+1)-1
-      if (acsr1%ja(j) == i) then 
-        acsr1%val(j) = zone - acsr1%val(j)*omf(acsr1%ja(j))
-      else
-        acsr1%val(j) =      - acsr1%val(j)*omf(acsr1%ja(j))
-      end if
-    end do
-  end do
-  call atmp%mv_from(acsr1)
-
-  call rtilde%mv_to(tmpcoo)
-  nzl = tmpcoo%get_nzeros()
-  i=0
-  do k=1, nzl
-    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
-      i = i+1
-      tmpcoo%val(i) = tmpcoo%val(k)
-      tmpcoo%ia(i)  = tmpcoo%ia(k)
-      tmpcoo%ja(i)  = tmpcoo%ja(k)
-    end if
-  end do
-  call tmpcoo%set_nzeros(i)
-  call rtilde%mv_from(tmpcoo)
-  call rtilde%cscnv(info,type='csr')
-
-  call psb_spspmm(rtilde,atmp,op_restr,info)
-
-  !
-  ! Now we have to gather the halo of op_prol, and add it to itself
-  ! to multiply it by A,
-  !
-  call op_prol%clone(tmp_prol,info) 
-  if (info == psb_success_) call psb_sphalo(tmp_prol,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.)
-  if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol')
-    goto 9999
-  end if
-
-  !
-  ! Now we have to fix this.  The only rows of B that are correct 
-  ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
-  !
-  call op_restr%mv_to(tmpcoo)
-
-  nzl = tmpcoo%get_nzeros()
-  i=0
-  do k=1, nzl
-    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
-      i = i+1
-      tmpcoo%val(i) = tmpcoo%val(k)
-      tmpcoo%ia(i)  = tmpcoo%ia(k)
-      tmpcoo%ja(i)  = tmpcoo%ja(k)
-    end if
-  end do
-  call tmpcoo%set_nzeros(i)
-  call op_restr%mv_from(tmpcoo)
-  call op_restr%cscnv(info,type='csr')
-
-
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'starting sphalo/ rwxtd'
-
-  call psb_spspmm(la,tmp_prol,am3,info)
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done SPSPMM 2'
-
-  call psb_sphalo(am3,desc_a,am4,info,&
-       & colcnv=.false.,rowscale=.true.)
-  if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4)      
-  if (info == psb_success_) call am4%free()
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,&
-         & a_err='Extend am3')
-    goto 9999
-  end if
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done sphalo/ rwxtd'
-
-  call psb_spspmm(op_restr,am3,ac,info)
-  if (info == psb_success_) call am3%free()
-  if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_)
-
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,&
-         &a_err='Build ac = op_restr x am3')
-    goto 9999
-  end if
+!!$  ! Get the diagonal D
+!!$  adiag =  a%get_diag(info)
+!!$  if (info == psb_success_) &
+!!$       & call psb_realloc(ncol,adiag,info)    
+!!$  if (info == psb_success_) &
+!!$       & call psb_halo(adiag,desc_a,info)
+!!$  if (info == psb_success_) call a%cp_to_l(la)
+!!$  if (info /= psb_success_) then
+!!$    call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
+!!$    goto 9999
+!!$  end if
+!!$
+!!$  do i=1,size(adiag)
+!!$    if (adiag(i) /= zzero) then
+!!$      adinv(i) = zone / adiag(i)
+!!$    else
+!!$      adinv(i) = zone
+!!$    end if
+!!$  end do
+!!$
+!!$
+!!$
+!!$  ! 1. Allocate Ptilde in sparse matrix form 
+!!$  call op_prol%mv_to(tmpcoo)
+!!$  call ptilde%mv_from(tmpcoo)
+!!$  call ptilde%cscnv(info,type='csr')
+!!$
+!!$  if (info == psb_success_) call la%cscnv(am3,info,type='csr',dupl=psb_dupl_add_)
+!!$  if (info == psb_success_) call la%cscnv(da,info,type='csr',dupl=psb_dupl_add_)
+!!$  if (info /= psb_success_) then
+!!$    call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
+!!$    goto 9999
+!!$  end if
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & ' Initial copies done.'
+!!$
+!!$  call da%scal(adinv,info)
+!!$
+!!$  call psb_spspmm(da,ptilde,dap,info)
+!!$
+!!$  if(info /= psb_success_) then
+!!$    call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
+!!$    goto 9999
+!!$  end if
+!!$
+!!$  call dap%clone(atmp,info)
+!!$
+!!$  call psb_sphalo(atmp,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
+!!$  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$  call psb_spspmm(da,atmp,dadap,info)
+!!$  call atmp%free()
+!!$
+!!$  !  !$  write(0,*) 'Columns of AP',psb_sp_get_ncols(ap)
+!!$  !  !$  write(0,*) 'Columns of ADAP',psb_sp_get_ncols(adap)
+!!$  call dap%mv_to(csc_dap)
+!!$  call dadap%mv_to(csc_dadap)
+!!$
+!!$  call csc_mat_col_prod(csc_dap,csc_dadap,omp,info)
+!!$  call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info)
+!!$  call psb_sum(ctxt,omp)
+!!$  call psb_sum(ctxt,oden)
+!!$  ! !$  write(0,*) trim(name),' OMP :',omp
+!!$  ! !$  write(0,*) trim(name),' ODEN:',oden
+!!$
+!!$  omp = omp/oden
+!!$
+!!$  ! !$  write(0,*) 'Check on output prolongator ',omp(1:min(size(omp),10))
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'Done NUMBMM 1'
+!!$
+!!$  call am3%mv_to(acsr3)
+!!$  ! Compute omega_int
+!!$  ommx = zzero
+!!$  do i=1, ncol
+!!$    if (ilaggr(i) >0) then 
+!!$      omi(i) = omp(ilaggr(i))
+!!$    else
+!!$      omi(i) = zzero
+!!$    end if
+!!$    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
+!!$  end do
+!!$  ! Compute omega_fine
+!!$  do i=1, nrow
+!!$    omf(i) = ommx
+!!$    do j=acsr3%irp(i),acsr3%irp(i+1)-1
+!!$      if(abs(omi(acsr3%ja(j))) .lt. abs(omf(i))) omf(i)=omi(acsr3%ja(j))
+!!$    end do
+!!$ ! !     if(min(real(omf(i)),aimag(omf(i))) < dzero) omf(i) = zzero
+!!$    if(psb_minreal(omf(i)) < dzero) omf(i) = zzero
+!!$  end do
+!!$
+!!$  omf(1:nrow) = omf(1:nrow) * adinv(1:nrow)
+!!$
+!!$  if (filter_mat) then
+!!$    !
+!!$    ! Build the filtered matrix Af from A
+!!$    ! 
+!!$    call la%cscnv(acsrf,info,dupl=psb_dupl_add_)
+!!$
+!!$    do i=1,nrow
+!!$      tmp = zzero
+!!$      jd  = -1 
+!!$      do j=acsrf%irp(i),acsrf%irp(i+1)-1
+!!$        if (acsrf%ja(j) == i) jd = j 
+!!$        if (abs(acsrf%val(j)) < theta*sqrt(abs(adiag(i)*adiag(acsrf%ja(j))))) then
+!!$          tmp=tmp+acsrf%val(j)
+!!$          acsrf%val(j)=zzero
+!!$        endif
+!!$      enddo
+!!$      if (jd == -1) then 
+!!$        write(0,*) 'Wrong input: we need the diagonal!!!!', i
+!!$      else
+!!$        acsrf%val(jd)=acsrf%val(jd)-tmp
+!!$      end if
+!!$    enddo
+!!$    ! Take out zeroed terms 
+!!$    call acsrf%clean_zeros(info)
+!!$
+!!$    !
+!!$    ! Build the smoothed prolongator using the filtered matrix
+!!$    ! 
+!!$    do i=1,acsrf%get_nrows()
+!!$      do j=acsrf%irp(i),acsrf%irp(i+1)-1
+!!$        if (acsrf%ja(j) == i) then 
+!!$          acsrf%val(j) = zone - omf(i)*acsrf%val(j) 
+!!$        else
+!!$          acsrf%val(j) = - omf(i)*acsrf%val(j) 
+!!$        end if
+!!$      end do
+!!$    end do
+!!$
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done gather, going for SYMBMM 1'
+!!$
+!!$    call af%mv_from(acsrf)
+!!$    !
+!!$    ! op_prol = (I-w*D*Af)Ptilde
+!!$    ! Doing it this way means to consider diag(Af_i)
+!!$    ! 
+!!$    !
+!!$    call psb_spspmm(af,ptilde,op_prol,info)
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done SPSPMM 1'
+!!$  else
+!!$    !
+!!$    ! Build the smoothed prolongator using the original matrix
+!!$    !
+!!$    do i=1,acsr3%get_nrows()
+!!$      do j=acsr3%irp(i),acsr3%irp(i+1)-1
+!!$        if (acsr3%ja(j) == i) then 
+!!$          acsr3%val(j) = zone - omf(i)*acsr3%val(j) 
+!!$        else
+!!$          acsr3%val(j) = - omf(i)*acsr3%val(j) 
+!!$        end if
+!!$      end do
+!!$    end do
+!!$
+!!$    call am3%mv_from(acsr3)
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done gather, going for SYMBMM 1'
+!!$    !
+!!$    ! 
+!!$    ! op_prol = (I-w*D*A)Ptilde
+!!$    ! 
+!!$    !
+!!$    call psb_spspmm(am3,ptilde,op_prol,info)
+!!$    if (debug_level >= psb_debug_outer_) &
+!!$         & write(debug_unit,*) me,' ',trim(name),&
+!!$         & 'Done NUMBMM 1'
+!!$
+!!$  end if
+!!$
+!!$
+!!$  !
+!!$  ! Ok, let's start over with the restrictor
+!!$  ! 
+!!$  call ptilde%transc(rtilde)
+!!$  call la%cscnv(atmp,info,type='csr')
+!!$  call psb_sphalo(atmp,desc_a,am4,info,&
+!!$       & colcnv=.true.,rowscale=.true.)
+!!$  nrt  = am4%get_nrows() 
+!!$  call am4%csclip(atmp2,info,lone,nrt,lone,ncol)
+!!$  call atmp2%cscnv(info,type='CSR')
+!!$  if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=atmp2)      
+!!$  call am4%free()
+!!$  call atmp2%free()
+!!$
+!!$  ! This is to compute the transpose. It ONLY works if the
+!!$  ! original A has a symmetric pattern.
+!!$  call atmp%transc(atmp2) 
+!!$  call atmp2%csclip(dat,info,lone,nrow,lone,ncol)
+!!$  call dat%cscnv(info,type='csr')
+!!$  call dat%scal(adinv,info)
+!!$
+!!$  ! Now for the product. 
+!!$  call psb_spspmm(dat,ptilde,datp,info)
+!!$
+!!$  call datp%clone(atmp2,info)
+!!$  call psb_sphalo(atmp2,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.,outfmt='CSR  ')
+!!$  if (info == psb_success_) call psb_rwextd(ncol,atmp2,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$
+!!$  call psb_symbmm(dat,atmp2,datdatp,info)
+!!$  call psb_numbmm(dat,atmp2,datdatp)
+!!$  call atmp2%free()
+!!$
+!!$  call datp%mv_to(csc_datp)    
+!!$  call datdatp%mv_to(csc_datdatp)    
+!!$
+!!$  call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info)
+!!$  call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info)
+!!$  call psb_sum(ctxt,omp)
+!!$  call psb_sum(ctxt,oden)
+!!$
+!!$
+!!$  ! !$  write(debug_unit,*) trim(name),' OMP_R :',omp
+!!$  ! ! $  write(debug_unit,*) trim(name),' ODEN_R:',oden
+!!$  omp = omp/oden
+!!$  ! !$  write(0,*) 'Check on output restrictor',omp(1:min(size(omp),10))
+!!$  ! Compute omega_int
+!!$  ommx = zzero
+!!$  do i=1, ncol
+!!$    if (ilaggr(i) >0) then 
+!!$      omi(i) = omp(ilaggr(i))
+!!$    else
+!!$      omi(i) = zzero
+!!$    end if
+!!$    if(abs(omi(i)) .gt. abs(ommx)) ommx = omi(i)
+!!$  end do
+!!$  ! Compute omega_fine
+!!$  ! Going over the columns of atmp means going over the rows
+!!$  ! of A^T. Hopefully ;-) 
+!!$  call atmp%cp_to(acsc)
+!!$
+!!$  do i=1, nrow
+!!$    omf(i) = ommx
+!!$    do j= acsc%icp(i),acsc%icp(i+1)-1
+!!$      if(abs(omi(acsc%ia(j))) .lt. abs(omf(i))) omf(i)=omi(acsc%ia(j))
+!!$    end do
+!!$ ! !    if(min(real(omf(i)),aimag(omf(i))) < dzero) omf(i) = zzero
+!!$    if(psb_minreal(omf(i)) < dzero) omf(i) = zzero
+!!$  end do
+!!$  omf(1:nrow) = omf(1:nrow)*adinv(1:nrow)
+!!$  call psb_halo(omf,desc_a,info)
+!!$  call acsc%free() 
+!!$
+!!$
+!!$  call atmp%mv_to(acsr1)
+!!$
+!!$  do i=1,acsr1%get_nrows()
+!!$    do j=acsr1%irp(i),acsr1%irp(i+1)-1
+!!$      if (acsr1%ja(j) == i) then 
+!!$        acsr1%val(j) = zone - acsr1%val(j)*omf(acsr1%ja(j))
+!!$      else
+!!$        acsr1%val(j) =      - acsr1%val(j)*omf(acsr1%ja(j))
+!!$      end if
+!!$    end do
+!!$  end do
+!!$  call atmp%mv_from(acsr1)
+!!$
+!!$  call rtilde%mv_to(tmpcoo)
+!!$  nzl = tmpcoo%get_nzeros()
+!!$  i=0
+!!$  do k=1, nzl
+!!$    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
+!!$      i = i+1
+!!$      tmpcoo%val(i) = tmpcoo%val(k)
+!!$      tmpcoo%ia(i)  = tmpcoo%ia(k)
+!!$      tmpcoo%ja(i)  = tmpcoo%ja(k)
+!!$    end if
+!!$  end do
+!!$  call tmpcoo%set_nzeros(i)
+!!$  call rtilde%mv_from(tmpcoo)
+!!$  call rtilde%cscnv(info,type='csr')
+!!$
+!!$  call psb_spspmm(rtilde,atmp,op_restr,info)
+!!$
+!!$  !
+!!$  ! Now we have to gather the halo of op_prol, and add it to itself
+!!$  ! to multiply it by A,
+!!$  !
+!!$  call op_prol%clone(tmp_prol,info) 
+!!$  if (info == psb_success_) call psb_sphalo(tmp_prol,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.)
+!!$  if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$  if(info /= psb_success_) then
+!!$    call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol')
+!!$    goto 9999
+!!$  end if
+!!$
+!!$  !
+!!$  ! Now we have to fix this.  The only rows of B that are correct 
+!!$  ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
+!!$  !
+!!$  call op_restr%mv_to(tmpcoo)
+!!$
+!!$  nzl = tmpcoo%get_nzeros()
+!!$  i=0
+!!$  do k=1, nzl
+!!$    if ((naggrm1 < tmpcoo%ia(k)) .and. (tmpcoo%ia(k) <= naggrp1)) then
+!!$      i = i+1
+!!$      tmpcoo%val(i) = tmpcoo%val(k)
+!!$      tmpcoo%ia(i)  = tmpcoo%ia(k)
+!!$      tmpcoo%ja(i)  = tmpcoo%ja(k)
+!!$    end if
+!!$  end do
+!!$  call tmpcoo%set_nzeros(i)
+!!$  call op_restr%mv_from(tmpcoo)
+!!$  call op_restr%cscnv(info,type='csr')
+!!$
+!!$
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'starting sphalo/ rwxtd'
+!!$
+!!$  call psb_spspmm(la,tmp_prol,am3,info)
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'Done SPSPMM 2'
+!!$
+!!$  call psb_sphalo(am3,desc_a,am4,info,&
+!!$       & colcnv=.false.,rowscale=.true.)
+!!$  if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4)      
+!!$  if (info == psb_success_) call am4%free()
+!!$
+!!$  if(info /= psb_success_) then
+!!$    call psb_errpush(psb_err_internal_error_,name,&
+!!$         & a_err='Extend am3')
+!!$    goto 9999
+!!$  end if
+!!$  if (debug_level >= psb_debug_outer_) &
+!!$       & write(debug_unit,*) me,' ',trim(name),&
+!!$       & 'Done sphalo/ rwxtd'
+!!$
+!!$  call psb_spspmm(op_restr,am3,ac,info)
+!!$  if (info == psb_success_) call am3%free()
+!!$  if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_)
+!!$
+!!$  if (info /= psb_success_) then
+!!$    call psb_errpush(psb_err_internal_error_,name,&
+!!$         &a_err='Build ac = op_restr x am3')
+!!$    goto 9999
+!!$  end if
 
 
 

amgprec/impl/aggregator/amg_zaggrmat_smth_bld.f90

@@ -116,7 +116,7 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
   type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
   type(amg_dml_parms), intent(inout)      :: parms 
-  type(psb_zspmat_type), intent(out)      :: op_prol,ac,op_restr
+  type(psb_zspmat_type), intent(inout)      :: op_prol,ac,op_restr
   type(psb_lzspmat_type), intent(inout)    :: t_prol
   type(psb_desc_type), intent(inout)       :: desc_ac
   integer(psb_ipk_), intent(out)           :: info

amgprec/impl/aggregator/preProcessorDirectives.h

@@ -72,7 +72,9 @@
 #include <map>
 
 //MPI:
+#if !defined(SERIAL_MPI)
 #include "mpi.h"
+#endif
 
 
 

amgprec/impl/amg_c_extprol_bld.F90

@@ -311,7 +311,7 @@ subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
 
     
     if (i>2) then 
-      if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then 
+      if (all(p%precv(i)%linmap%naggr == p%precv(i-1)%linmap%naggr)) then 
         newsz=i-1
       end if
       call psb_bcast(ctxt,newsz)
@@ -518,7 +518,7 @@ contains
     !  op_prol => PR     i.e. prolongation operator
     !  
     
-    p%map = psb_linmap(psb_map_aggr_,desc_a,&
+    p%linmap = psb_linmap(psb_map_aggr_,desc_a,&
          & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
     if(info /= psb_success_) then
       call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')

amgprec/impl/amg_ccprecset.F90

@@ -462,6 +462,14 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           select case (psb_toupper(string))
           case('BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
+#if defined(HAVE_SLU_)
+            call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+#elif defined(HAVE_MUMPS_)
+            call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+#else
+            call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+#endif
+            call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
           case('L1-BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
 #if defined(HAVE_SLU_)
@@ -612,6 +620,14 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
         select case (psb_toupper(trim(string)))
         case('BJAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
+#if defined(HAVE_SLU_)
+          call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+#elif defined(HAVE_MUMPS_)
+          call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+#else
+          call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+#endif
+          call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
         case('L1-BJAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
 #if defined(HAVE_SLU_)

amgprec/impl/amg_cfile_prec_descr.f90

@@ -65,7 +65,7 @@
 !         0: normal
 !        >1: increased details 
 !
-subroutine amg_cfile_prec_descr(prec,iout,root, verbosity)
+subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity)
   use psb_base_mod
   use amg_c_prec_mod, amg_protect_name => amg_cfile_prec_descr
   use amg_c_inner_mod
@@ -74,13 +74,14 @@ subroutine amg_cfile_prec_descr(prec,iout,root, verbosity)
   implicit none 
   ! Arguments
   class(amg_cprec_type), intent(in)      :: prec
+  integer(psb_ipk_), intent(out) :: info
   integer(psb_ipk_), intent(in), optional :: iout
   integer(psb_ipk_), intent(in), optional :: root
   integer(psb_ipk_), intent(in), optional   :: verbosity
 
 
   ! Local variables
-  integer(psb_ipk_)   :: ilev, nlev, ilmin, info, nswps
+  integer(psb_ipk_)   :: ilev, nlev, ilmin, nswps
   type(psb_ctxt_type) :: ctxt
   integer(psb_ipk_)   :: me, np
   logical             :: is_symgs

amgprec/impl/amg_cprecinit.F90

@@ -1,15 +1,15 @@
-!   
-!   
+!
+!
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
 !               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
+!
+!    (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:
@@ -21,7 +21,7 @@
 !      3. The name of the AMG4PSBLAS group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
-!   
+!
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -33,8 +33,8 @@
 !    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_cprecinit.f90
 !
 ! Subroutine: amg_cprecinit
@@ -42,21 +42,21 @@
 !
 !  This routine allocates and initializes the preconditioner data structure,
 !  according to the preconditioner type chosen by the user.
-!  
+!
 !  A default preconditioner is set for each preconditioner type
 !  specified by the user:
 !
 !    'NOPREC'         - no preconditioner
 !
-!    'DIAG', 'JACOBI' - diagonal/Jacobi           
+!    'DIAG', 'JACOBI' - diagonal/Jacobi
 !
 !    'L1-DIAG', 'L1-JACOBI' - diagonal/Jacobi  with L1 norm correction
 !
 !    'GS', 'FBGS'     - Hybrid Gauss-Seidel, also symmetrized
-!                       
+!
 !    'BJAC'           - block Jacobi preconditioner, with ILU(0)
 !                       on the local blocks
-!                       
+!
 !    'L1-BJAC'        - block Jacobi preconditioner, with ILU(0)
 !                       on the local blocks and L1 correction for off-diag blocks
 !
@@ -70,12 +70,12 @@
 !                       applied as post-smoother at each level, but the
 !                       coarsest one; four sweeps of the block-Jacobi solver,
 !                       with LU from UMFPACK on the blocks, are applied at
-!                       the coarsest level, on the distributed coarse matrix. 
+!                       the coarsest level, on the distributed coarse matrix.
 !                       The smoothed aggregation algorithm with threshold 0
 !                       is used to build the coarse matrix.
 !
 !  For the multilevel preconditioners, the levels are numbered in increasing
-!  order starting from the finest one, i.e. level 1 is the finest level. 
+!  order starting from the finest one, i.e. level 1 is the finest level.
 !
 !
 ! Arguments:
@@ -87,7 +87,7 @@
 !               lowercase strings).
 !    info    -  integer, output.
 !               Error code.
-!  
+!
 subroutine amg_cprecinit(ctxt,prec,ptype,info)
 
   use psb_base_mod
@@ -113,98 +113,105 @@ subroutine amg_cprecinit(ctxt,prec,ptype,info)
 
   ! Local variables
   integer(psb_ipk_)            :: nlev_, ilev_
+  integer(psb_ipk_)            :: err_act
+  integer(psb_ipk_)            :: debug_level, debug_unit
   real(psb_spk_)               :: thr
   character(len=*), parameter  :: name='amg_precinit'
   info = psb_success_
+  call psb_erractionsave(err_act)
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_; goto 9999
+  end if
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
 
-  if (allocated(prec%precv)) then 
-    call prec%free(info) 
-    if (info /= psb_success_) then 
-      ! Do we want to do something? 
+  if (allocated(prec%precv)) then
+    call prec%free(info)
+    if (info /= psb_success_) then
+      ! Do we want to do something?
     endif
   endif
   prec%ctxt = ctxt
-  prec%ag_data%min_coarse_size             = -1
-  prec%ag_data%min_coarse_size_per_process = -1
+  call prec%ag_data%default()
 
   select case(psb_toupper(trim(ptype)))
-  case ('NOPREC','NONE') 
+  case ('NOPREC','NONE')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_c_base_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_c_base_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_c_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_c_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('JAC','DIAG','JACOBI') 
+  case ('JAC','DIAG','JACOBI')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_c_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_c_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('L1-DIAG','L1-JACOBI','L1_DIAG','L1_JACOBI') 
+  case ('L1-DIAG','L1-JACOBI','L1_DIAG','L1_JACOBI')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_c_l1_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_c_l1_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('GS','FWGS') 
+  case ('GS','FWGS')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_c_gs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_c_gs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('BWGS') 
+  case ('BWGS')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_c_bwgs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_c_bwgs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('FBGS') 
+  case ('FBGS')
     nlev_ = 1
     ilev_ = 1
     allocate(prec%precv(nlev_),stat=info)
     call prec%set('SMOOTHER_TYPE','FBGS',info)
     call prec%precv(ilev_)%default()
 
-  case ('BJAC') 
+  case ('BJAC')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('L1-BJAC','L1_BJAC') 
+  case ('L1-BJAC','L1_BJAC')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_c_l1_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_c_l1_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
   case ('AS')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_c_as_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_c_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
 
@@ -213,20 +220,24 @@ subroutine amg_cprecinit(ctxt,prec,ptype,info)
     nlev_ = prec%ag_data%max_levs
     ilev_ = 1
     allocate(prec%precv(nlev_),stat=info)
+    if (info /= psb_success_ ) then
+      call psb_errpush(info,name,a_err='Error from hierarchy init')
+      goto 9999
+    endif
 
-    do ilev_ = 1, nlev_  
+    do ilev_ = 1, nlev_
       call prec%precv(ilev_)%default()
     end do
     call prec%set('ML_CYCLE','VCYCLE',info)
     call prec%set('SMOOTHER_TYPE','FBGS',info)
 #if  defined(HAVE_MUMPS_)
-    call prec%set('COARSE_SOLVE','MUMPS',info)    
+    call prec%set('COARSE_SOLVE','MUMPS',info)
 #elif defined(HAVE_SLU_)
     call prec%set('COARSE_SOLVE','SLU',info)
 #else
     call prec%set('COARSE_SOLVE','ILU',info)
 #endif
-    
+
   case default
     write(psb_err_unit,*) name,&
          &': Warning: Unknown preconditioner type request "',ptype,'"'
@@ -234,5 +245,10 @@ subroutine amg_cprecinit(ctxt,prec,ptype,info)
 
   end select
 
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
 
 end subroutine amg_cprecinit

amgprec/impl/amg_cprecset.F90

@@ -45,7 +45,7 @@ subroutine amg_cprecsetsm(p,val,info,ilev,ilmax,pos)
   implicit none
 
   ! Arguments
-  class(amg_cprec_type), intent(inout)         :: p
+  class(amg_cprec_type), target, intent(inout):: p
   class(amg_c_base_smoother_type), intent(in) :: val
   integer(psb_ipk_), intent(out)              :: info
   integer(psb_ipk_), optional, intent(in)     :: ilev,ilmax

amgprec/impl/amg_d_extprol_bld.F90

@@ -311,7 +311,7 @@ subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
 
     
     if (i>2) then 
-      if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then 
+      if (all(p%precv(i)%linmap%naggr == p%precv(i-1)%linmap%naggr)) then 
         newsz=i-1
       end if
       call psb_bcast(ctxt,newsz)
@@ -518,7 +518,7 @@ contains
     !  op_prol => PR     i.e. prolongation operator
     !  
     
-    p%map = psb_linmap(psb_map_aggr_,desc_a,&
+    p%linmap = psb_linmap(psb_map_aggr_,desc_a,&
          & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
     if(info /= psb_success_) then
       call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')

amgprec/impl/amg_dcprecset.F90

@@ -474,6 +474,16 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           select case (psb_toupper(string))
           case('BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
+#if defined(HAVE_UMF_)
+            call p%precv(nlev_)%set('SUB_SOLVE',amg_umf_,info,pos=pos)
+#elif defined(HAVE_SLU_)
+            call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+#elif defined(HAVE_MUMPS_)
+            call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+#else
+            call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+#endif
+            call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
           case('L1-BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
 #if defined(HAVE_UMF_)
@@ -638,6 +648,16 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
         select case (psb_toupper(trim(string)))
         case('BJAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
+#if defined(HAVE_UMF_)
+          call p%precv(nlev_)%set('SUB_SOLVE',amg_umf_,info,pos=pos)
+#elif defined(HAVE_SLU_)
+          call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+#elif defined(HAVE_MUMPS_)
+          call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+#else
+          call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+#endif
+          call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
         case('L1-BJAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
 #if defined(HAVE_UMF_)

amgprec/impl/amg_dfile_prec_descr.f90

@@ -65,7 +65,7 @@
 !         0: normal
 !        >1: increased details 
 !
-subroutine amg_dfile_prec_descr(prec,iout,root, verbosity)
+subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity)
   use psb_base_mod
   use amg_d_prec_mod, amg_protect_name => amg_dfile_prec_descr
   use amg_d_inner_mod
@@ -74,13 +74,14 @@ subroutine amg_dfile_prec_descr(prec,iout,root, verbosity)
   implicit none 
   ! Arguments
   class(amg_dprec_type), intent(in)      :: prec
+  integer(psb_ipk_), intent(out) :: info
   integer(psb_ipk_), intent(in), optional :: iout
   integer(psb_ipk_), intent(in), optional :: root
   integer(psb_ipk_), intent(in), optional   :: verbosity
 
 
   ! Local variables
-  integer(psb_ipk_)   :: ilev, nlev, ilmin, info, nswps
+  integer(psb_ipk_)   :: ilev, nlev, ilmin, nswps
   type(psb_ctxt_type) :: ctxt
   integer(psb_ipk_)   :: me, np
   logical             :: is_symgs

amgprec/impl/amg_dprecinit.F90

@@ -1,15 +1,15 @@
-!   
-!   
+!
+!
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
 !               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
+!
+!    (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:
@@ -21,7 +21,7 @@
 !      3. The name of the AMG4PSBLAS group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
-!   
+!
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -33,8 +33,8 @@
 !    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_dprecinit.f90
 !
 ! Subroutine: amg_dprecinit
@@ -42,21 +42,21 @@
 !
 !  This routine allocates and initializes the preconditioner data structure,
 !  according to the preconditioner type chosen by the user.
-!  
+!
 !  A default preconditioner is set for each preconditioner type
 !  specified by the user:
 !
 !    'NOPREC'         - no preconditioner
 !
-!    'DIAG', 'JACOBI' - diagonal/Jacobi           
+!    'DIAG', 'JACOBI' - diagonal/Jacobi
 !
 !    'L1-DIAG', 'L1-JACOBI' - diagonal/Jacobi  with L1 norm correction
 !
 !    'GS', 'FBGS'     - Hybrid Gauss-Seidel, also symmetrized
-!                       
+!
 !    'BJAC'           - block Jacobi preconditioner, with ILU(0)
 !                       on the local blocks
-!                       
+!
 !    'L1-BJAC'        - block Jacobi preconditioner, with ILU(0)
 !                       on the local blocks and L1 correction for off-diag blocks
 !
@@ -70,12 +70,12 @@
 !                       applied as post-smoother at each level, but the
 !                       coarsest one; four sweeps of the block-Jacobi solver,
 !                       with LU from UMFPACK on the blocks, are applied at
-!                       the coarsest level, on the distributed coarse matrix. 
+!                       the coarsest level, on the distributed coarse matrix.
 !                       The smoothed aggregation algorithm with threshold 0
 !                       is used to build the coarse matrix.
 !
 !  For the multilevel preconditioners, the levels are numbered in increasing
-!  order starting from the finest one, i.e. level 1 is the finest level. 
+!  order starting from the finest one, i.e. level 1 is the finest level.
 !
 !
 ! Arguments:
@@ -87,7 +87,7 @@
 !               lowercase strings).
 !    info    -  integer, output.
 !               Error code.
-!  
+!
 subroutine amg_dprecinit(ctxt,prec,ptype,info)
 
   use psb_base_mod
@@ -116,98 +116,105 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info)
 
   ! Local variables
   integer(psb_ipk_)            :: nlev_, ilev_
+  integer(psb_ipk_)            :: err_act
+  integer(psb_ipk_)            :: debug_level, debug_unit
   real(psb_dpk_)               :: thr
   character(len=*), parameter  :: name='amg_precinit'
   info = psb_success_
+  call psb_erractionsave(err_act)
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_; goto 9999
+  end if
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
 
-  if (allocated(prec%precv)) then 
-    call prec%free(info) 
-    if (info /= psb_success_) then 
-      ! Do we want to do something? 
+  if (allocated(prec%precv)) then
+    call prec%free(info)
+    if (info /= psb_success_) then
+      ! Do we want to do something?
     endif
   endif
   prec%ctxt = ctxt
-  prec%ag_data%min_coarse_size             = -1
-  prec%ag_data%min_coarse_size_per_process = -1
+  call prec%ag_data%default()
 
   select case(psb_toupper(trim(ptype)))
-  case ('NOPREC','NONE') 
+  case ('NOPREC','NONE')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_d_base_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_d_base_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_d_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_d_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('JAC','DIAG','JACOBI') 
+  case ('JAC','DIAG','JACOBI')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_d_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_d_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('L1-DIAG','L1-JACOBI','L1_DIAG','L1_JACOBI') 
+  case ('L1-DIAG','L1-JACOBI','L1_DIAG','L1_JACOBI')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_d_l1_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_d_l1_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('GS','FWGS') 
+  case ('GS','FWGS')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_d_gs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_d_gs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('BWGS') 
+  case ('BWGS')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_d_bwgs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_d_bwgs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('FBGS') 
+  case ('FBGS')
     nlev_ = 1
     ilev_ = 1
     allocate(prec%precv(nlev_),stat=info)
     call prec%set('SMOOTHER_TYPE','FBGS',info)
     call prec%precv(ilev_)%default()
 
-  case ('BJAC') 
+  case ('BJAC')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('L1-BJAC','L1_BJAC') 
+  case ('L1-BJAC','L1_BJAC')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_d_l1_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_d_l1_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
   case ('AS')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_d_as_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_d_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
 
@@ -216,22 +223,26 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info)
     nlev_ = prec%ag_data%max_levs
     ilev_ = 1
     allocate(prec%precv(nlev_),stat=info)
+    if (info /= psb_success_ ) then
+      call psb_errpush(info,name,a_err='Error from hierarchy init')
+      goto 9999
+    endif
 
-    do ilev_ = 1, nlev_  
+    do ilev_ = 1, nlev_
       call prec%precv(ilev_)%default()
     end do
     call prec%set('ML_CYCLE','VCYCLE',info)
     call prec%set('SMOOTHER_TYPE','FBGS',info)
-#if defined(HAVE_UMF_) 
+#if defined(HAVE_UMF_)
     call prec%set('COARSE_SOLVE','UMF',info)
 #elif defined(HAVE_MUMPS_)
-    call prec%set('COARSE_SOLVE','MUMPS',info)    
+    call prec%set('COARSE_SOLVE','MUMPS',info)
 #elif defined(HAVE_SLU_)
     call prec%set('COARSE_SOLVE','SLU',info)
 #else
     call prec%set('COARSE_SOLVE','ILU',info)
 #endif
-    
+
   case default
     write(psb_err_unit,*) name,&
          &': Warning: Unknown preconditioner type request "',ptype,'"'
@@ -239,5 +250,10 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info)
 
   end select
 
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
 
 end subroutine amg_dprecinit

amgprec/impl/amg_dprecset.F90

@@ -45,7 +45,7 @@ subroutine amg_dprecsetsm(p,val,info,ilev,ilmax,pos)
   implicit none
 
   ! Arguments
-  class(amg_dprec_type), intent(inout)         :: p
+  class(amg_dprec_type), target, intent(inout):: p
   class(amg_d_base_smoother_type), intent(in) :: val
   integer(psb_ipk_), intent(out)              :: info
   integer(psb_ipk_), optional, intent(in)     :: ilev,ilmax

amgprec/impl/amg_s_extprol_bld.F90

@@ -311,7 +311,7 @@ subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
 
     
     if (i>2) then 
-      if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then 
+      if (all(p%precv(i)%linmap%naggr == p%precv(i-1)%linmap%naggr)) then 
         newsz=i-1
       end if
       call psb_bcast(ctxt,newsz)
@@ -518,7 +518,7 @@ contains
     !  op_prol => PR     i.e. prolongation operator
     !  
     
-    p%map = psb_linmap(psb_map_aggr_,desc_a,&
+    p%linmap = psb_linmap(psb_map_aggr_,desc_a,&
          & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
     if(info /= psb_success_) then
       call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')

amgprec/impl/amg_scprecset.F90

@@ -462,6 +462,14 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           select case (psb_toupper(string))
           case('BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
+#if defined(HAVE_SLU_)
+            call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+#elif defined(HAVE_MUMPS_)
+            call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+#else
+            call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+#endif
+            call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
           case('L1-BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
 #if defined(HAVE_SLU_)
@@ -612,6 +620,14 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
         select case (psb_toupper(trim(string)))
         case('BJAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
+#if defined(HAVE_SLU_)
+          call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+#elif defined(HAVE_MUMPS_)
+          call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+#else
+          call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+#endif
+          call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
         case('L1-BJAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
 #if defined(HAVE_SLU_)

amgprec/impl/amg_sfile_prec_descr.f90

@@ -65,7 +65,7 @@
 !         0: normal
 !        >1: increased details 
 !
-subroutine amg_sfile_prec_descr(prec,iout,root, verbosity)
+subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity)
   use psb_base_mod
   use amg_s_prec_mod, amg_protect_name => amg_sfile_prec_descr
   use amg_s_inner_mod
@@ -74,13 +74,14 @@ subroutine amg_sfile_prec_descr(prec,iout,root, verbosity)
   implicit none 
   ! Arguments
   class(amg_sprec_type), intent(in)      :: prec
+  integer(psb_ipk_), intent(out) :: info
   integer(psb_ipk_), intent(in), optional :: iout
   integer(psb_ipk_), intent(in), optional :: root
   integer(psb_ipk_), intent(in), optional   :: verbosity
 
 
   ! Local variables
-  integer(psb_ipk_)   :: ilev, nlev, ilmin, info, nswps
+  integer(psb_ipk_)   :: ilev, nlev, ilmin, nswps
   type(psb_ctxt_type) :: ctxt
   integer(psb_ipk_)   :: me, np
   logical             :: is_symgs

amgprec/impl/amg_sprecinit.F90

@@ -1,15 +1,15 @@
-!   
-!   
+!
+!
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
 !               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
+!
+!    (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:
@@ -21,7 +21,7 @@
 !      3. The name of the AMG4PSBLAS group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
-!   
+!
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -33,8 +33,8 @@
 !    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_sprecinit.f90
 !
 ! Subroutine: amg_sprecinit
@@ -42,21 +42,21 @@
 !
 !  This routine allocates and initializes the preconditioner data structure,
 !  according to the preconditioner type chosen by the user.
-!  
+!
 !  A default preconditioner is set for each preconditioner type
 !  specified by the user:
 !
 !    'NOPREC'         - no preconditioner
 !
-!    'DIAG', 'JACOBI' - diagonal/Jacobi           
+!    'DIAG', 'JACOBI' - diagonal/Jacobi
 !
 !    'L1-DIAG', 'L1-JACOBI' - diagonal/Jacobi  with L1 norm correction
 !
 !    'GS', 'FBGS'     - Hybrid Gauss-Seidel, also symmetrized
-!                       
+!
 !    'BJAC'           - block Jacobi preconditioner, with ILU(0)
 !                       on the local blocks
-!                       
+!
 !    'L1-BJAC'        - block Jacobi preconditioner, with ILU(0)
 !                       on the local blocks and L1 correction for off-diag blocks
 !
@@ -70,12 +70,12 @@
 !                       applied as post-smoother at each level, but the
 !                       coarsest one; four sweeps of the block-Jacobi solver,
 !                       with LU from UMFPACK on the blocks, are applied at
-!                       the coarsest level, on the distributed coarse matrix. 
+!                       the coarsest level, on the distributed coarse matrix.
 !                       The smoothed aggregation algorithm with threshold 0
 !                       is used to build the coarse matrix.
 !
 !  For the multilevel preconditioners, the levels are numbered in increasing
-!  order starting from the finest one, i.e. level 1 is the finest level. 
+!  order starting from the finest one, i.e. level 1 is the finest level.
 !
 !
 ! Arguments:
@@ -87,7 +87,7 @@
 !               lowercase strings).
 !    info    -  integer, output.
 !               Error code.
-!  
+!
 subroutine amg_sprecinit(ctxt,prec,ptype,info)
 
   use psb_base_mod
@@ -113,98 +113,105 @@ subroutine amg_sprecinit(ctxt,prec,ptype,info)
 
   ! Local variables
   integer(psb_ipk_)            :: nlev_, ilev_
+  integer(psb_ipk_)            :: err_act
+  integer(psb_ipk_)            :: debug_level, debug_unit
   real(psb_spk_)               :: thr
   character(len=*), parameter  :: name='amg_precinit'
   info = psb_success_
+  call psb_erractionsave(err_act)
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_; goto 9999
+  end if
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
 
-  if (allocated(prec%precv)) then 
-    call prec%free(info) 
-    if (info /= psb_success_) then 
-      ! Do we want to do something? 
+  if (allocated(prec%precv)) then
+    call prec%free(info)
+    if (info /= psb_success_) then
+      ! Do we want to do something?
     endif
   endif
   prec%ctxt = ctxt
-  prec%ag_data%min_coarse_size             = -1
-  prec%ag_data%min_coarse_size_per_process = -1
+  call prec%ag_data%default()
 
   select case(psb_toupper(trim(ptype)))
-  case ('NOPREC','NONE') 
+  case ('NOPREC','NONE')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_s_base_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_s_base_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_s_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_s_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('JAC','DIAG','JACOBI') 
+  case ('JAC','DIAG','JACOBI')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_s_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_s_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('L1-DIAG','L1-JACOBI','L1_DIAG','L1_JACOBI') 
+  case ('L1-DIAG','L1-JACOBI','L1_DIAG','L1_JACOBI')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_s_l1_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_s_l1_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('GS','FWGS') 
+  case ('GS','FWGS')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_s_gs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_s_gs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('BWGS') 
+  case ('BWGS')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_s_bwgs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_s_bwgs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('FBGS') 
+  case ('FBGS')
     nlev_ = 1
     ilev_ = 1
     allocate(prec%precv(nlev_),stat=info)
     call prec%set('SMOOTHER_TYPE','FBGS',info)
     call prec%precv(ilev_)%default()
 
-  case ('BJAC') 
+  case ('BJAC')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('L1-BJAC','L1_BJAC') 
+  case ('L1-BJAC','L1_BJAC')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_s_l1_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_s_l1_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
   case ('AS')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_s_as_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_s_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
 
@@ -213,20 +220,24 @@ subroutine amg_sprecinit(ctxt,prec,ptype,info)
     nlev_ = prec%ag_data%max_levs
     ilev_ = 1
     allocate(prec%precv(nlev_),stat=info)
+    if (info /= psb_success_ ) then
+      call psb_errpush(info,name,a_err='Error from hierarchy init')
+      goto 9999
+    endif
 
-    do ilev_ = 1, nlev_  
+    do ilev_ = 1, nlev_
       call prec%precv(ilev_)%default()
     end do
     call prec%set('ML_CYCLE','VCYCLE',info)
     call prec%set('SMOOTHER_TYPE','FBGS',info)
 #if  defined(HAVE_MUMPS_)
-    call prec%set('COARSE_SOLVE','MUMPS',info)    
+    call prec%set('COARSE_SOLVE','MUMPS',info)
 #elif defined(HAVE_SLU_)
     call prec%set('COARSE_SOLVE','SLU',info)
 #else
     call prec%set('COARSE_SOLVE','ILU',info)
 #endif
-    
+
   case default
     write(psb_err_unit,*) name,&
          &': Warning: Unknown preconditioner type request "',ptype,'"'
@@ -234,5 +245,10 @@ subroutine amg_sprecinit(ctxt,prec,ptype,info)
 
   end select
 
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
 
 end subroutine amg_sprecinit

amgprec/impl/amg_sprecset.F90

@@ -45,7 +45,7 @@ subroutine amg_sprecsetsm(p,val,info,ilev,ilmax,pos)
   implicit none
 
   ! Arguments
-  class(amg_sprec_type), intent(inout)         :: p
+  class(amg_sprec_type), target, intent(inout):: p
   class(amg_s_base_smoother_type), intent(in) :: val
   integer(psb_ipk_), intent(out)              :: info
   integer(psb_ipk_), optional, intent(in)     :: ilev,ilmax

amgprec/impl/amg_z_extprol_bld.F90

@@ -311,7 +311,7 @@ subroutine amg_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
 
     
     if (i>2) then 
-      if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then 
+      if (all(p%precv(i)%linmap%naggr == p%precv(i-1)%linmap%naggr)) then 
         newsz=i-1
       end if
       call psb_bcast(ctxt,newsz)
@@ -518,7 +518,7 @@ contains
     !  op_prol => PR     i.e. prolongation operator
     !  
     
-    p%map = psb_linmap(psb_map_aggr_,desc_a,&
+    p%linmap = psb_linmap(psb_map_aggr_,desc_a,&
          & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
     if(info /= psb_success_) then
       call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')

amgprec/impl/amg_zcprecset.F90

@@ -474,6 +474,16 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           select case (psb_toupper(string))
           case('BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
+#if defined(HAVE_UMF_)
+            call p%precv(nlev_)%set('SUB_SOLVE',amg_umf_,info,pos=pos)
+#elif defined(HAVE_SLU_)
+            call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+#elif defined(HAVE_MUMPS_)
+            call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+#else
+            call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+#endif
+            call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
           case('L1-BJAC')
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
 #if defined(HAVE_UMF_)
@@ -638,6 +648,16 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
         select case (psb_toupper(trim(string)))
         case('BJAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
+#if defined(HAVE_UMF_)
+          call p%precv(nlev_)%set('SUB_SOLVE',amg_umf_,info,pos=pos)
+#elif defined(HAVE_SLU_)
+          call p%precv(nlev_)%set('SUB_SOLVE',amg_slu_,info,pos=pos)
+#elif defined(HAVE_MUMPS_)
+          call p%precv(nlev_)%set('SUB_SOLVE',amg_mumps_,info,pos=pos)
+#else
+          call p%precv(nlev_)%set('SUB_SOLVE',psb_ilu_n_,info,pos=pos)
+#endif
+          call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info)
         case('L1-BJAC')
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
 #if defined(HAVE_UMF_)

amgprec/impl/amg_zfile_prec_descr.f90

@@ -65,7 +65,7 @@
 !         0: normal
 !        >1: increased details 
 !
-subroutine amg_zfile_prec_descr(prec,iout,root, verbosity)
+subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity)
   use psb_base_mod
   use amg_z_prec_mod, amg_protect_name => amg_zfile_prec_descr
   use amg_z_inner_mod
@@ -74,13 +74,14 @@ subroutine amg_zfile_prec_descr(prec,iout,root, verbosity)
   implicit none 
   ! Arguments
   class(amg_zprec_type), intent(in)      :: prec
+  integer(psb_ipk_), intent(out) :: info
   integer(psb_ipk_), intent(in), optional :: iout
   integer(psb_ipk_), intent(in), optional :: root
   integer(psb_ipk_), intent(in), optional   :: verbosity
 
 
   ! Local variables
-  integer(psb_ipk_)   :: ilev, nlev, ilmin, info, nswps
+  integer(psb_ipk_)   :: ilev, nlev, ilmin, nswps
   type(psb_ctxt_type) :: ctxt
   integer(psb_ipk_)   :: me, np
   logical             :: is_symgs

amgprec/impl/amg_zprecinit.F90

@@ -1,15 +1,15 @@
-!   
-!   
+!
+!
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
 !               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
+!
+!    (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:
@@ -21,7 +21,7 @@
 !      3. The name of the AMG4PSBLAS group or the names of its contributors may
 !         not be used to endorse or promote products derived from this
 !         software without specific written permission.
-!   
+!
 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 !    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 !    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@@ -33,8 +33,8 @@
 !    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_zprecinit.f90
 !
 ! Subroutine: amg_zprecinit
@@ -42,21 +42,21 @@
 !
 !  This routine allocates and initializes the preconditioner data structure,
 !  according to the preconditioner type chosen by the user.
-!  
+!
 !  A default preconditioner is set for each preconditioner type
 !  specified by the user:
 !
 !    'NOPREC'         - no preconditioner
 !
-!    'DIAG', 'JACOBI' - diagonal/Jacobi           
+!    'DIAG', 'JACOBI' - diagonal/Jacobi
 !
 !    'L1-DIAG', 'L1-JACOBI' - diagonal/Jacobi  with L1 norm correction
 !
 !    'GS', 'FBGS'     - Hybrid Gauss-Seidel, also symmetrized
-!                       
+!
 !    'BJAC'           - block Jacobi preconditioner, with ILU(0)
 !                       on the local blocks
-!                       
+!
 !    'L1-BJAC'        - block Jacobi preconditioner, with ILU(0)
 !                       on the local blocks and L1 correction for off-diag blocks
 !
@@ -70,12 +70,12 @@
 !                       applied as post-smoother at each level, but the
 !                       coarsest one; four sweeps of the block-Jacobi solver,
 !                       with LU from UMFPACK on the blocks, are applied at
-!                       the coarsest level, on the distributed coarse matrix. 
+!                       the coarsest level, on the distributed coarse matrix.
 !                       The smoothed aggregation algorithm with threshold 0
 !                       is used to build the coarse matrix.
 !
 !  For the multilevel preconditioners, the levels are numbered in increasing
-!  order starting from the finest one, i.e. level 1 is the finest level. 
+!  order starting from the finest one, i.e. level 1 is the finest level.
 !
 !
 ! Arguments:
@@ -87,7 +87,7 @@
 !               lowercase strings).
 !    info    -  integer, output.
 !               Error code.
-!  
+!
 subroutine amg_zprecinit(ctxt,prec,ptype,info)
 
   use psb_base_mod
@@ -116,98 +116,105 @@ subroutine amg_zprecinit(ctxt,prec,ptype,info)
 
   ! Local variables
   integer(psb_ipk_)            :: nlev_, ilev_
+  integer(psb_ipk_)            :: err_act
+  integer(psb_ipk_)            :: debug_level, debug_unit
   real(psb_dpk_)               :: thr
   character(len=*), parameter  :: name='amg_precinit'
   info = psb_success_
+  call psb_erractionsave(err_act)
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_; goto 9999
+  end if
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
 
-  if (allocated(prec%precv)) then 
-    call prec%free(info) 
-    if (info /= psb_success_) then 
-      ! Do we want to do something? 
+  if (allocated(prec%precv)) then
+    call prec%free(info)
+    if (info /= psb_success_) then
+      ! Do we want to do something?
     endif
   endif
   prec%ctxt = ctxt
-  prec%ag_data%min_coarse_size             = -1
-  prec%ag_data%min_coarse_size_per_process = -1
+  call prec%ag_data%default()
 
   select case(psb_toupper(trim(ptype)))
-  case ('NOPREC','NONE') 
+  case ('NOPREC','NONE')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_z_base_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_z_base_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_z_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_z_id_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('JAC','DIAG','JACOBI') 
+  case ('JAC','DIAG','JACOBI')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_z_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_z_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('L1-DIAG','L1-JACOBI','L1_DIAG','L1_JACOBI') 
+  case ('L1-DIAG','L1-JACOBI','L1_DIAG','L1_JACOBI')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_z_l1_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_z_l1_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('GS','FWGS') 
+  case ('GS','FWGS')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_z_gs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_z_gs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('BWGS') 
+  case ('BWGS')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_z_bwgs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_z_bwgs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('FBGS') 
+  case ('FBGS')
     nlev_ = 1
     ilev_ = 1
     allocate(prec%precv(nlev_),stat=info)
     call prec%set('SMOOTHER_TYPE','FBGS',info)
     call prec%precv(ilev_)%default()
 
-  case ('BJAC') 
+  case ('BJAC')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_z_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_z_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
-  case ('L1-BJAC','L1_BJAC') 
+  case ('L1-BJAC','L1_BJAC')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_z_l1_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_z_l1_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_z_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_z_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
   case ('AS')
     nlev_ = 1
     ilev_ = 1
-    allocate(prec%precv(nlev_),stat=info) 
-    allocate(amg_z_as_smoother_type :: prec%precv(ilev_)%sm, stat=info) 
+    allocate(prec%precv(nlev_),stat=info)
+    allocate(amg_z_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
     if (info /= psb_success_) return
-    allocate(amg_z_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) 
+    allocate(amg_z_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
     call prec%precv(ilev_)%default()
 
 
@@ -216,22 +223,26 @@ subroutine amg_zprecinit(ctxt,prec,ptype,info)
     nlev_ = prec%ag_data%max_levs
     ilev_ = 1
     allocate(prec%precv(nlev_),stat=info)
+    if (info /= psb_success_ ) then
+      call psb_errpush(info,name,a_err='Error from hierarchy init')
+      goto 9999
+    endif
 
-    do ilev_ = 1, nlev_  
+    do ilev_ = 1, nlev_
       call prec%precv(ilev_)%default()
     end do
     call prec%set('ML_CYCLE','VCYCLE',info)
     call prec%set('SMOOTHER_TYPE','FBGS',info)
-#if defined(HAVE_UMF_) 
+#if defined(HAVE_UMF_)
     call prec%set('COARSE_SOLVE','UMF',info)
 #elif defined(HAVE_MUMPS_)
-    call prec%set('COARSE_SOLVE','MUMPS',info)    
+    call prec%set('COARSE_SOLVE','MUMPS',info)
 #elif defined(HAVE_SLU_)
     call prec%set('COARSE_SOLVE','SLU',info)
 #else
     call prec%set('COARSE_SOLVE','ILU',info)
 #endif
-    
+
   case default
     write(psb_err_unit,*) name,&
          &': Warning: Unknown preconditioner type request "',ptype,'"'
@@ -239,5 +250,10 @@ subroutine amg_zprecinit(ctxt,prec,ptype,info)
 
   end select
 
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
 
 end subroutine amg_zprecinit

amgprec/impl/amg_zprecset.F90

@@ -45,7 +45,7 @@ subroutine amg_zprecsetsm(p,val,info,ilev,ilmax,pos)
   implicit none
 
   ! Arguments
-  class(amg_zprec_type), intent(inout)         :: p
+  class(amg_zprec_type), target, intent(inout):: p
   class(amg_z_base_smoother_type), intent(in) :: val
   integer(psb_ipk_), intent(out)              :: info
   integer(psb_ipk_), optional, intent(in)     :: ilev,ilmax

amgprec/impl/smoother/amg_c_as_smoother_free.f90

@@ -61,6 +61,7 @@ subroutine amg_c_as_smoother_free(sm,info)
     end if
   end if
   call sm%nd%free()
+  call sm%desc_data%free(info)
 
   call psb_erractionrestore(err_act)
   return

amgprec/impl/smoother/amg_d_as_smoother_free.f90

@@ -61,6 +61,7 @@ subroutine amg_d_as_smoother_free(sm,info)
     end if
   end if
   call sm%nd%free()
+  call sm%desc_data%free(info)
 
   call psb_erractionrestore(err_act)
   return

amgprec/impl/smoother/amg_s_as_smoother_free.f90

@@ -61,6 +61,7 @@ subroutine amg_s_as_smoother_free(sm,info)
     end if
   end if
   call sm%nd%free()
+  call sm%desc_data%free(info)
 
   call psb_erractionrestore(err_act)
   return

amgprec/impl/smoother/amg_z_as_smoother_free.f90

@@ -61,6 +61,7 @@ subroutine amg_z_as_smoother_free(sm,info)
     end if
   end if
   call sm%nd%free()
+  call sm%desc_data%free(info)
 
   call psb_erractionrestore(err_act)
   return

amgprec/impl/solver/amg_c_base_solver_csetr.f90

@@ -42,7 +42,7 @@ subroutine amg_c_base_solver_csetr(sv,what,val,info,idx)
   Implicit None
   ! Arguments
   class(amg_c_base_solver_type), intent(inout) :: sv 
-  integer(psb_ipk_), intent(in)                  :: what 
+  character(len=*), intent(in)                   :: what 
   real(psb_spk_), intent(in)                      :: val
   integer(psb_ipk_), intent(out)                 :: info
   integer(psb_ipk_), intent(in), optional        :: idx

amgprec/impl/solver/amg_c_bwgs_solver_bld.f90

@@ -44,7 +44,7 @@ subroutine amg_c_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
 
   ! Arguments
   type(psb_cspmat_type), intent(in), target           :: a
-  Type(psb_desc_type), Intent(in)                     :: desc_a 
+  Type(psb_desc_type), Intent(inout)                  :: desc_a 
   class(amg_c_bwgs_solver_type), intent(inout)         :: sv
   integer(psb_ipk_), intent(out)                      :: info
   type(psb_cspmat_type), intent(in), target, optional :: b

amgprec/impl/solver/amg_c_krm_solver_impl.f90

@@ -77,7 +77,7 @@
 !  This is the implementation file corresponding to amg_c_krm_solver_mod.
 !
 !
-subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold)
+subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
 
   use psb_base_mod
   use amg_c_krm_solver, amg_protect_name => amg_c_krm_solver_bld
@@ -85,13 +85,14 @@ subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold)
   Implicit None
 
   ! Arguments
-  type(psb_cspmat_type), intent(inout), target        :: a
+  type(psb_cspmat_type), intent(in), target        :: a
   Type(psb_desc_type), Intent(inout)                  :: desc_a
   class(amg_c_krm_solver_type), intent(inout)         :: sv
   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
   ! Local variables
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
   integer(psb_lpk_) :: lnr

amgprec/impl/solver/amg_d_base_solver_csetr.f90

@@ -42,7 +42,7 @@ subroutine amg_d_base_solver_csetr(sv,what,val,info,idx)
   Implicit None
   ! Arguments
   class(amg_d_base_solver_type), intent(inout) :: sv 
-  integer(psb_ipk_), intent(in)                  :: what 
+  character(len=*), intent(in)                   :: what 
   real(psb_dpk_), intent(in)                      :: val
   integer(psb_ipk_), intent(out)                 :: info
   integer(psb_ipk_), intent(in), optional        :: idx

amgprec/impl/solver/amg_d_bwgs_solver_bld.f90

@@ -44,7 +44,7 @@ subroutine amg_d_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
 
   ! Arguments
   type(psb_dspmat_type), intent(in), target           :: a
-  Type(psb_desc_type), Intent(in)                     :: desc_a 
+  Type(psb_desc_type), Intent(inout)                  :: desc_a 
   class(amg_d_bwgs_solver_type), intent(inout)         :: sv
   integer(psb_ipk_), intent(out)                      :: info
   type(psb_dspmat_type), intent(in), target, optional :: b

amgprec/impl/solver/amg_d_krm_solver_impl.f90

@@ -77,7 +77,7 @@
 !  This is the implementation file corresponding to amg_d_krm_solver_mod.
 !
 !
-subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold)
+subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
 
   use psb_base_mod
   use amg_d_krm_solver, amg_protect_name => amg_d_krm_solver_bld
@@ -85,13 +85,14 @@ subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold)
   Implicit None
 
   ! Arguments
-  type(psb_dspmat_type), intent(inout), target        :: a
+  type(psb_dspmat_type), intent(in), target        :: a
   Type(psb_desc_type), Intent(inout)                  :: desc_a
   class(amg_d_krm_solver_type), intent(inout)         :: sv
   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
   ! Local variables
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
   integer(psb_lpk_) :: lnr

amgprec/impl/solver/amg_s_base_solver_csetr.f90

@@ -42,7 +42,7 @@ subroutine amg_s_base_solver_csetr(sv,what,val,info,idx)
   Implicit None
   ! Arguments
   class(amg_s_base_solver_type), intent(inout) :: sv 
-  integer(psb_ipk_), intent(in)                  :: what 
+  character(len=*), intent(in)                   :: what 
   real(psb_spk_), intent(in)                      :: val
   integer(psb_ipk_), intent(out)                 :: info
   integer(psb_ipk_), intent(in), optional        :: idx

amgprec/impl/solver/amg_s_bwgs_solver_bld.f90

@@ -44,7 +44,7 @@ subroutine amg_s_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
 
   ! Arguments
   type(psb_sspmat_type), intent(in), target           :: a
-  Type(psb_desc_type), Intent(in)                     :: desc_a 
+  Type(psb_desc_type), Intent(inout)                  :: desc_a 
   class(amg_s_bwgs_solver_type), intent(inout)         :: sv
   integer(psb_ipk_), intent(out)                      :: info
   type(psb_sspmat_type), intent(in), target, optional :: b

amgprec/impl/solver/amg_s_krm_solver_impl.f90

@@ -77,7 +77,7 @@
 !  This is the implementation file corresponding to amg_s_krm_solver_mod.
 !
 !
-subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold)
+subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
 
   use psb_base_mod
   use amg_s_krm_solver, amg_protect_name => amg_s_krm_solver_bld
@@ -85,13 +85,14 @@ subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold)
   Implicit None
 
   ! Arguments
-  type(psb_sspmat_type), intent(inout), target        :: a
+  type(psb_sspmat_type), intent(in), target        :: a
   Type(psb_desc_type), Intent(inout)                  :: desc_a
   class(amg_s_krm_solver_type), intent(inout)         :: sv
   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
   ! Local variables
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
   integer(psb_lpk_) :: lnr

amgprec/impl/solver/amg_z_base_solver_csetr.f90

@@ -42,7 +42,7 @@ subroutine amg_z_base_solver_csetr(sv,what,val,info,idx)
   Implicit None
   ! Arguments
   class(amg_z_base_solver_type), intent(inout) :: sv 
-  integer(psb_ipk_), intent(in)                  :: what 
+  character(len=*), intent(in)                   :: what 
   real(psb_dpk_), intent(in)                      :: val
   integer(psb_ipk_), intent(out)                 :: info
   integer(psb_ipk_), intent(in), optional        :: idx

amgprec/impl/solver/amg_z_bwgs_solver_bld.f90

@@ -44,7 +44,7 @@ subroutine amg_z_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
 
   ! Arguments
   type(psb_zspmat_type), intent(in), target           :: a
-  Type(psb_desc_type), Intent(in)                     :: desc_a 
+  Type(psb_desc_type), Intent(inout)                  :: desc_a 
   class(amg_z_bwgs_solver_type), intent(inout)         :: sv
   integer(psb_ipk_), intent(out)                      :: info
   type(psb_zspmat_type), intent(in), target, optional :: b

amgprec/impl/solver/amg_z_krm_solver_impl.f90

@@ -77,7 +77,7 @@
 !  This is the implementation file corresponding to amg_z_krm_solver_mod.
 !
 !
-subroutine amg_z_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold)
+subroutine amg_z_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
 
   use psb_base_mod
   use amg_z_krm_solver, amg_protect_name => amg_z_krm_solver_bld
@@ -85,13 +85,14 @@ subroutine amg_z_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold)
   Implicit None
 
   ! Arguments
-  type(psb_zspmat_type), intent(inout), target        :: a
+  type(psb_zspmat_type), intent(in), target        :: a
   Type(psb_desc_type), Intent(inout)                  :: desc_a
   class(amg_z_krm_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
   ! Local variables
   integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
   integer(psb_lpk_) :: lnr

autogen_n.sh

@@ -0,0 +1,26 @@
+#!/bin/sh
+# $Id$
+
+# This file is still not complete.
+
+# this should create configure from configure.ac..
+
+#touch NEWS AUTHORS ChangeLog COPYING INSTALL missing install-sh
+
+#libtoolize
+
+aclocal -I config  || { echo "no aclocal  ?" ; exit 1 ; }
+
+# we produce a configure script
+autoconf -o configure_n configure_n.ac || { echo "no autoconf ?" ; exit 1 ; }
+
+# we produce a brand new Makefile
+#automake -i --add-missing || { echo "no automake ?" ; exit 1 ; }
+#automake  -i || { echo "no automake ?" ; exit 1 ; }
+
+# The automake required for autogen.sh'in this package is 1.10#.
+# So users who want to build from the svn repository are required to use this version.
+# 
+# Users building from the tarball shouldn't bother, of course, 
+# because they get the configure script generated from the tarball maintainer.
+

cbind/amgprec/amg_dprec_cbind_mod.F90

@@ -384,7 +384,7 @@ contains
 
    integer(psb_c_ipk_) :: res
    type(psb_c_object_type) :: ph
-   integer               :: info
+   integer(psb_c_ipk_)     :: info
    type(amg_dprec_type), pointer :: precp
 
    res = -1
@@ -396,7 +396,7 @@ contains
    end if
 
 
-   call precp%descr()
+   call precp%descr(info)
    call flush(psb_out_unit)
 
    info = 0

cbind/amgprec/amg_zprec_cbind_mod.F90

@@ -384,7 +384,7 @@ contains
 
    integer(psb_c_ipk_) :: res
    type(psb_c_object_type) :: ph
-   integer               :: info
+   integer(psb_c_ipk_)     :: info
    type(amg_zprec_type), pointer :: precp
 
    res = -1
@@ -396,7 +396,7 @@ contains
    end if
 
 
-   call precp%descr()
+   call precp%descr(info)
    call flush(psb_out_unit)
 
    info = 0

config/pac.m4

@@ -2181,3 +2181,223 @@ else
 fi
 ])dnl PAC_LAPACK
 
+
+dnl @synopsis PAC_ARG_WITH_IPK
+dnl
+dnl Test for --with-ipk 
+dnl 
+dnl 
+dnl
+dnl Example use: --with-ipk=4
+dnl
+dnl
+dnl @author Salvatore Filippone <salvatore.filippone@uniroma2.it>
+dnl
+AC_DEFUN([PAC_ARG_WITH_IPK],
+[
+AC_MSG_CHECKING([what size in bytes we want for local indices and data])
+AC_ARG_WITH(ipk,
+	    AC_HELP_STRING([--with-ipk=<bytes>], 
+			   [Specify the size in bytes for local indices and data, default 4 bytes. ]),
+	    [pac_cv_ipk_size=$withval;],
+	    [pac_cv_ipk_size=4;]
+	   )
+if test x"$pac_cv_ipk_size" == x"4"  || test  x"$pac_cv_ipk_size" == x"8" ; then
+   AC_MSG_RESULT([Size: $pac_cv_ipk_size.])
+else
+  AC_MSG_RESULT([Unsupported value for IPK: $pac_cv_ipk_size, defaulting to 4.])
+  pac_cv_ipk_size=4;
+fi
+]
+)
+
+dnl @synopsis PAC_ARG_WITH_LPK
+dnl
+dnl Test for --with-lpk 
+dnl 
+dnl 
+dnl
+dnl Example use: --with-lpk=8
+dnl
+dnl
+dnl @author Salvatore Filippone <salvatore.filippone@uniroma2.it>
+dnl
+AC_DEFUN([PAC_ARG_WITH_LPK],
+[
+ AC_MSG_CHECKING([what size in bytes we want for global indices and data])
+ AC_ARG_WITH(lpk,
+	     AC_HELP_STRING([--with-lpk=<bytes>], 
+			    [Specify the size in bytes for global indices and data, default 8 bytes. ]),
+	     [pac_cv_lpk_size=$withval;],
+	     [pac_cv_lpk_size=8;]
+	    )
+if test x"$pac_cv_lpk_size" == x"4" || test x"$pac_cv_lpk_size" == x"8"; then
+  AC_MSG_RESULT([Size: $pac_cv_lpk_size.])
+else
+  AC_MSG_RESULT([Unsupported value for LPK: $pac_cv_lpk_size, defaulting to 8.])
+  pac_cv_lpk_size=8;
+fi
+]
+)
+
+
+dnl @synopsis PAC_CHECK_METIS
+dnl
+dnl Will try to find the METIS library and headers.
+dnl
+dnl Will use $CC
+dnl
+dnl If the test passes, will execute ACTION-IF-FOUND. Otherwise, ACTION-IF-NOT-FOUND.
+dnl Note : This file will be likely to induce the compiler to create a module file
+dnl (for a module called conftest).
+dnl Depending on the compiler flags, this could cause a conftest.mod file to appear
+dnl in the present directory, or in another, or with another name. So be warned!
+dnl
+dnl @author Salvatore Filippone <salvatore.filippone@uniroma2.it>
+dnl
+AC_DEFUN(PAC_CHECK_METIS,
+[AC_ARG_WITH(metis, AC_HELP_STRING([--with-metis=LIBNAME], [Specify the library name for METIS library. 
+Default: "-lmetis"]),
+        [psblas_cv_metis=$withval],
+        [psblas_cv_metis='-lmetis'])
+AC_ARG_WITH(metisincfile, AC_HELP_STRING([--with-metisincfile=DIR], [Specify the name  for METIS include file.]),
+        [psblas_cv_metisincfile=$withval],
+        [psblas_cv_metisincfile='metis.h'])
+AC_ARG_WITH(metisdir, AC_HELP_STRING([--with-metisdir=DIR], [Specify the directory for METIS library and includes.]),
+        [psblas_cv_metisdir=$withval],
+        [psblas_cv_metisdir=''])
+AC_ARG_WITH(metisincdir, AC_HELP_STRING([--with-metisincdir=DIR], [Specify the directory for METIS includes.]),
+        [psblas_cv_metisincdir=$withval],
+        [psblas_cv_metisincdir=''])
+AC_ARG_WITH(metislibdir, AC_HELP_STRING([--with-metislibdir=DIR], [Specify the directory for METIS library.]),
+        [psblas_cv_metislibdir=$withval],
+        [psblas_cv_metislibdir=''])
+
+AC_LANG([C])
+SAVE_LIBS="$LIBS"
+SAVE_CPPFLAGS="$CPPFLAGS"
+if test "x$psblas_cv_metisdir" != "x"; then 
+   METIS_LIBDIR="-L$psblas_cv_metisdir"
+   LIBS="-L$psblas_cv_metisdir $LIBS"
+   METIS_INCLUDES="-I$psblas_cv_metisdir"
+   CPPFLAGS="$METIS_INCLUDES $CPPFLAGS"
+fi
+if test "x$psblas_cv_metisincdir" != "x"; then 
+   METIS_INCLUDES="-I$psblas_cv_metisincdir"
+   CPPFLAGS="$METIS_INCLUDES $CPPFLAGS"
+fi
+if test "x$psblas_cv_metislibdir" != "x"; then 
+   LIBS="-L$psblas_cv_metislibdir $LIBS"
+   METIS_LIBDIR="-L$psblas_cv_metislibdir"
+fi
+
+AC_MSG_NOTICE([metis dir $psblas_cv_metisdir])
+AC_CHECK_HEADERS([limits.h $psblas_cv_metisincfile],
+ [pac_metis_header_ok=yes],
+ [pac_metis_header_ok=no; METIS_INCLUDES=""])
+if test "x$pac_metis_header_ok" == "xno" ; then
+dnl Maybe Include or include subdirs? 
+  unset ac_cv_header_metis_h
+  METIS_INCLUDES="-I$psblas_cv_metisdir/include -I$psblas_cv_metisdir/Include "
+  CPPFLAGS="$METIS_INCLUDES $SAVE_CPPFLAGS"
+
+ AC_MSG_CHECKING([for metis_h in $METIS_INCLUDES])
+ AC_CHECK_HEADERS([limits.h  $psblas_cv_metisincfile],
+    [pac_metis_header_ok=yes],
+    [pac_metis_header_ok=no; METIS_INCLUDES=""])
+fi
+if test "x$pac_metis_header_ok" == "xno" ; then
+dnl Maybe new structure with METIS UFconfig METIS? 
+   unset ac_cv_header_metis_h
+   METIS_INCLUDES="-I$psblas_cv_metisdir/UFconfig -I$psblas_cv_metisdir/METIS/Include -I$psblas_cv_metisdir/METIS/Include"
+   CPPFLAGS="$METIS_INCLUDES $SAVE_CPPFLAGS"
+   AC_CHECK_HEADERS([limits.h  $psblas_cv_metisincfile],
+     [pac_metis_header_ok=yes],
+     [pac_metis_header_ok=no; METIS_INCLUDES=""])
+fi
+
+if test "x$pac_metis_header_ok" == "xyes" ; then
+   AC_LANG_PUSH([C])
+   AC_MSG_CHECKING([for METIS integer size])
+   AC_LINK_IFELSE([AC_LANG_SOURCE(
+	#include <stdio.h>
+	#include "$psblas_cv_metisincfile"
+        void main(){
+		    printf("%d\n",IDXTYPEWIDTH);
+		    }
+	       )],
+	       [pac_cv_metis_idx=`./conftest${ac_exeext} | sed 's/^ *//'`],
+	       [pac_cv_metis_idx="unknown"])
+      AC_MSG_RESULT($pac_cv_metis_idx)
+
+   AC_LANG_POP()
+fi
+
+if test "x$pac_metis_header_ok" == "xyes" ; then
+   AC_LANG_PUSH([C])
+   AC_MSG_CHECKING([for METIS real size])
+   AC_LINK_IFELSE([AC_LANG_SOURCE(
+	#include <stdio.h>
+	#include "$psblas_cv_metisincfile"
+        void main(){
+		    printf("%d\n",REALTYPEWIDTH);
+		    }
+	       )],
+	       [pac_cv_metis_real=`./conftest${ac_exeext} | sed 's/^ *//'`],
+	       [pac_cv_metis_real="unknown"])
+      AC_MSG_RESULT($pac_cv_metis_real)
+
+   AC_LANG_POP()
+fi
+
+if test "x$pac_metis_header_ok" = "xyes" ; then 
+      psblas_cv_metis_includes="$METIS_INCLUDES"
+      METIS_LIBS="$psblas_cv_metis $METIS_LIBDIR"
+      LIBS="$METIS_LIBS -lm $LIBS";
+      AC_MSG_CHECKING([for METIS_PartGraphKway in $METIS_LIBS])
+      AC_TRY_LINK_FUNC(METIS_PartGraphKway, 
+       [psblas_cv_have_metis=yes;pac_metis_lib_ok=yes; ],
+       [psblas_cv_have_metis=no;pac_metis_lib_ok=no; METIS_LIBS=""])
+      AC_MSG_RESULT($pac_metis_lib_ok)
+     if test "x$pac_metis_lib_ok" = "xno" ; then 
+        dnl Maybe Lib or lib? 
+        METIS_LIBDIR="-L$psblas_cv_metisdir/Lib -L$psblas_cv_metisdir/lib"
+        METIS_LIBS="$psblas_cv_metis $METIS_LIBDIR"
+        LIBS="$METIS_LIBS -lm $SAVE_LIBS"
+        
+      AC_MSG_CHECKING([for METIS_PartGraphKway in $METIS_LIBS])
+      AC_TRY_LINK_FUNC(METIS_PartGraphKway, 
+       [psblas_cv_have_metis=yes;pac_metis_lib_ok=yes; ],
+       [psblas_cv_have_metis=no;pac_metis_lib_ok=no; METIS_LIBS=""])
+      AC_MSG_RESULT($pac_metis_lib_ok)
+     fi
+
+     if test "x$pac_metis_lib_ok" = "xno" ; then 
+        dnl Maybe METIS/Lib? 
+        METIS_LIBDIR="-L$psblas_cv_metisdir/METIS/Lib -L$psblas_cv_metisdir/METIS/Lib"
+        METIS_LIBS="$psblas_cv_metis $METIS_LIBDIR"
+        LIBS="$METIS_LIBS -lm $SAVE_LIBS"
+      AC_MSG_CHECKING([for METIS_PartGraphKway in $METIS_LIBS])
+      AC_TRY_LINK_FUNC(METIS_PartGraphKway, 
+       [psblas_cv_have_metis=yes;pac_metis_lib_ok="yes"; ],
+       [psblas_cv_have_metis=no;pac_metis_lib_ok="no"; METIS_LIBS=""])
+      AC_MSG_RESULT($pac_metis_lib_ok)
+      fi
+ fi
+dnl AC_MSG_NOTICE([ metis lib ok $pac_metis_lib_ok])
+
+ if test "x$pac_metis_lib_ok" = "xyes" ; then 
+      AC_MSG_CHECKING([for METIS_SetDefaultOptions in $LIBS])
+      AC_TRY_LINK_FUNC(METIS_SetDefaultOptions, 
+        [psblas_cv_have_metis=yes;pac_metis_lib_ok=yes; ],
+        [psblas_cv_have_metis=no;pac_metis_lib_ok="no. Unusable METIS version, sorry."; METIS_LIBS=""
+      ])
+      AC_MSG_RESULT($pac_metis_lib_ok)
+
+fi
+
+LIBS="$SAVE_LIBS";
+CPPFLAGS="$SAVE_CPPFLAGS";
+])dnl 
+
+

configure

@@ -726,7 +726,6 @@ infodir
 docdir
 oldincludedir
 includedir
-runstatedir
 localstatedir
 sharedstatedir
 sysconfdir
@@ -838,7 +837,6 @@ datadir='${datarootdir}'
 sysconfdir='${prefix}/etc'
 sharedstatedir='${prefix}/com'
 localstatedir='${prefix}/var'
-runstatedir='${localstatedir}/run'
 includedir='${prefix}/include'
 oldincludedir='/usr/include'
 docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
@@ -1091,15 +1089,6 @@ do
   | -silent | --silent | --silen | --sile | --sil)
     silent=yes ;;
 
-  -runstatedir | --runstatedir | --runstatedi | --runstated \
-  | --runstate | --runstat | --runsta | --runst | --runs \
-  | --run | --ru | --r)
-    ac_prev=runstatedir ;;
-  -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \
-  | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \
-  | --run=* | --ru=* | --r=*)
-    runstatedir=$ac_optarg ;;
-
   -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
     ac_prev=sbindir ;;
   -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
@@ -1237,7 +1226,7 @@ fi
 for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
 		datadir sysconfdir sharedstatedir localstatedir includedir \
 		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
-		libdir localedir mandir runstatedir
+		libdir localedir mandir
 do
   eval ac_val=\$$ac_var
   # Remove trailing slashes.
@@ -1390,7 +1379,6 @@ Fine tuning of the installation directories:
   --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]
   --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]
   --localstatedir=DIR     modifiable single-machine data [PREFIX/var]
-  --runstatedir=DIR       modifiable per-process data [LOCALSTATEDIR/run]
   --libdir=DIR            object code libraries [EPREFIX/lib]
   --includedir=DIR        C header files [PREFIX/include]
   --oldincludedir=DIR     C header files for non-gcc [/usr/include]
@@ -2667,10 +2655,12 @@ if test "X$PSBLAS_DIR" != "X" ; then
   fi
   { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PSBLAS_DIR" >&5
 $as_echo "$PSBLAS_DIR" >&6; }
+fi
+if test "X$PSBLAS_INCDIR" != "X" ; then
   pac_cv_status_file="$PSBLAS_INCDIR/Make.inc.psblas"
   if test ! -f "$pac_cv_status_file" ; then
-    { $as_echo "$as_me:${as_lineno-$LINENO}: Could not find an installation  in $PSBLAS_DIR." >&5
-$as_echo "$as_me: Could not find an installation  in $PSBLAS_DIR." >&6;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: Could not find the status file in $PSBLAS_INCDIR." >&5
+$as_echo "$as_me: Could not find the status file in $PSBLAS_INCDIR." >&6;}
     pac_cv_status_file="NONE";
   fi
 else
@@ -4418,6 +4408,8 @@ if test x"$pac_cv_serial_mpi" == x"yes" ; then
    FAKEMPI="fakempi.o";
    MPIFC="$FC";
    MPICC="$CC";
+   CXXDEFINES="-DSERIAL_MPI $CXXDEFINES";
+
 else
 ac_ext=c
 ac_cpp='$CPP $CPPFLAGS'
@@ -8432,11 +8424,12 @@ if test "x$amg4psblas_cv_have_mumps" == "xyes" ; then
       { $as_echo "$as_me:${as_lineno-$LINENO}: PSBLAS defines PSB_LPK_ as $pac_cv_psblas_lpk. MUMPS interfacing will fail when called in global mode on very large matrices. " >&5
 $as_echo "$as_me: PSBLAS defines PSB_LPK_ as $pac_cv_psblas_lpk. MUMPS interfacing will fail when called in global mode on very large matrices. " >&6;}
    fi
-   MUMPS_FLAGS="-DHave_MUMPS_ $MUMPS_INCLUDES"
    if test "x$pac_mumps_fmods_ok" == "xyes" ; then
       FDEFINES="$amg_cv_define_prepend-DHAVE_MUMPS_ $amg_cv_define_prepend-DHAVE_MUMPS_MODULES_ $MUMPS_MODULES $FDEFINES"
+       MUMPS_FLAGS="-DHave_MUMPS_ $MUMPS_MODULES"
    elif test "x$pac_mumps_fincs_ok" == "xyes" ; then
       FDEFINES="$amg_cv_define_prepend-DHAVE_MUMPS_ $amg_cv_define_prepend-DHAVE_MUMPS_INCLUDES_ $MUMPS_FINCLUDES $FDEFINES"
+       MUMPS_FLAGS="-DHave_MUMPS_ $MUMPS_INCLUDES"
    else
       # This should not happen
       MUMPS_FLAGS=""

configure.ac

@@ -77,14 +77,16 @@ if test "X$PSBLAS_DIR" != "X" ; then
     AC_MSG_ERROR([Could not find PSBLAS build dir $PSBLAS_DIR!])	
   fi
   AC_MSG_RESULT([$PSBLAS_DIR])
+fi	
+if test "X$PSBLAS_INCDIR" != "X" ; then 
   pac_cv_status_file="$PSBLAS_INCDIR/Make.inc.psblas"
   if test ! -f "$pac_cv_status_file" ; then 
-    AC_MSG_NOTICE([Could not find an installation  in $PSBLAS_DIR.])
+    AC_MSG_NOTICE([Could not find the status file in $PSBLAS_INCDIR.])
     pac_cv_status_file="NONE";
   fi
 else
   pac_cv_status_file="NONE";
-fi	
+fi
 
 dnl. $pac_cv_status_file
 AC_MSG_NOTICE([Loaded $pac_cv_status_file $FC $MPIFC $BLACS_LIBS])
@@ -169,6 +171,8 @@ if test x"$pac_cv_serial_mpi" == x"yes" ; then
    FAKEMPI="fakempi.o";
    MPIFC="$FC";
    MPICC="$CC";
+   CXXDEFINES="-DSERIAL_MPI $CXXDEFINES";
+
 else 
 AC_LANG([C])
 if test "X$MPICC" = "X" ; then
@@ -654,11 +658,12 @@ if test "x$amg4psblas_cv_have_mumps" == "xyes" ; then
    if test "x$pac_cv_psblas_lpk" == "x8" ; then
       AC_MSG_NOTICE([PSBLAS defines PSB_LPK_ as $pac_cv_psblas_lpk. MUMPS interfacing will fail when called in global mode on very large matrices. ])
    fi	
-   MUMPS_FLAGS="-DHave_MUMPS_ $MUMPS_INCLUDES"
    if test "x$pac_mumps_fmods_ok" == "xyes" ; then 
       FDEFINES="$amg_cv_define_prepend-DHAVE_MUMPS_ $amg_cv_define_prepend-DHAVE_MUMPS_MODULES_ $MUMPS_MODULES $FDEFINES"
+       MUMPS_FLAGS="-DHave_MUMPS_ $MUMPS_MODULES"
    elif test "x$pac_mumps_fincs_ok" == "xyes" ; then
       FDEFINES="$amg_cv_define_prepend-DHAVE_MUMPS_ $amg_cv_define_prepend-DHAVE_MUMPS_INCLUDES_ $MUMPS_FINCLUDES $FDEFINES"
+       MUMPS_FLAGS="-DHave_MUMPS_ $MUMPS_INCLUDES"
    else
       # This should not happen
       MUMPS_FLAGS=""

configure_n.ac

@@ -0,0 +1,991 @@
+dnl $Id$
+
+dnl Process this file with autoconf to produce a configure script.
+dnl
+dnl usage : aclocal -I config/ && autoconf && ./configure && make 
+
+dnl then  : VAR=VAL ./configure
+
+dnl In some configurations (AIX) the next line is needed:
+dnl MPIFC=mpxlf95 ./configure
+
+dnl then  : ./configure VAR=VAL 
+dnl then  : ./configure --help=short
+dnl then  : ./configure --help
+
+dnl the PSBLAS modules get this task difficult to accomplish!
+dnl SEE  : --module-path --include-path
+
+dnl NOTE : There is no cross compilation support.
+
+dnl NOTE : missing ifort and kl* library handling..
+dnl NOTE : odd configurations like ifc + gcc still await in the mist of the unknown
+
+
+###############################################################################
+###############################################################################
+# 
+#  This script is used by the PSBLAS to determine the compilers, linkers, and
+# libraries to build its libraries executable code.
+#  Its behaviour is driven on the compiler it finds or it is dictated to work
+# with.
+#
+###############################################################################
+###############################################################################
+
+# NOTE: the literal for version (the second argument to AC_INIT should be a literal!)
+AC_INIT([AMG4PSBLAS],1.0.0, [https://github.com/sfilippone/amg4psblas/issues])
+
+# VERSION is the file containing the PSBLAS version code
+# FIXME
+amg4psblas_cv_version="1.0.0"
+
+# A sample source file
+AC_CONFIG_SRCDIR([amgprec/amg_prec_type.f90])
+# Our custom M4 macros are in the 'config' directory
+AC_CONFIG_MACRO_DIR([config])
+AC_MSG_NOTICE([
+--------------------------------------------------------------------------------
+	Welcome to the $PACKAGE_NAME $amg4psblas_cv_version configure Script.
+
+	This creates Make.inc, but if you read carefully the
+	documentation, you can make your own by hand for your needs.
+
+        ./configure  --with-psblas=/path/to/psblas
+	See ./configure --help=short fore more info.
+--------------------------------------------------------------------------------
+		])
+
+###############################################################################
+# 			FLAGS and LIBS user customization
+###############################################################################
+
+dnl NOTE : no spaces before the comma, and no brackets before the second argument!
+PAC_ARG_WITH_PSBLAS
+PSBLAS_DIR="$pac_cv_psblas_dir";
+PSBLAS_INCDIR="$pac_cv_psblas_incdir";
+PSBLAS_MODDIR="$pac_cv_psblas_moddir";
+PSBLAS_LIBDIR="$pac_cv_psblas_libdir";
+AC_MSG_CHECKING([for PSBLAS install dir])
+if test "X$PSBLAS_DIR" != "X" ; then 
+   case $PSBLAS_DIR in 
+   	  /*) ;; 
+	   *)  AC_MSG_ERROR([The PSBLAS installation dir must be an absolute pathname
+ specified with --with-psblas=/path/to/psblas])
+ esac
+  if test ! -d "$PSBLAS_DIR" ; then 
+    AC_MSG_ERROR([Could not find PSBLAS build dir $PSBLAS_DIR!])	
+  fi
+  AC_MSG_RESULT([$PSBLAS_DIR])
+fi	
+
+AM_INIT_AUTOMAKE
+dnl Specify required version of autoconf.
+AC_PREREQ(2.59)
+#
+# Installation. 
+#
+#
+AC_PROG_INSTALL
+
+AC_MSG_CHECKING([where to install])
+case $prefix in  
+   \/* )   eval "INSTALL_DIR=$prefix";;
+   * ) eval "INSTALL_DIR=/usr/local/amg4psblas";;
+esac
+case $libdir in 
+   \/* )   eval "INSTALL_LIBDIR=$libdir";;
+   * ) eval "INSTALL_LIBDIR=$INSTALL_DIR/lib";;
+esac
+case $includedir in 
+   \/* )   eval "INSTALL_INCLUDEDIR=$includedir";;
+   * ) eval "INSTALL_INCLUDEDIR=$INSTALL_DIR/include";;
+esac
+INSTALL_MODULESDIR=$INSTALL_DIR/modules
+case $docsdir in 
+   \/* )   eval "INSTALL_DOCSDIR=$docsdir";;
+   * ) eval "INSTALL_DOCSDIR=$INSTALL_DIR/docs";;
+esac
+case $samplesdir in 
+   \/* )   eval "INSTALL_SAMPLESDIR=$samplesdir";;
+   * ) eval "INSTALL_SAMPLESDIR=$INSTALL_DIR/samples";;
+esac
+AC_MSG_RESULT([$INSTALL_DIR $INSTALL_INCLUDEDIR $INSTALL_MODULESDIR $INSTALL_LIBDIR $INSTALL_DOCSDIR $INSTALL_SAMPLESDIR])
+
+dnl
+dnl We set our own FC flags, ignore those from AC_PROG_FC but not those from the
+dnl environment variable. Same for C
+dnl 
+save_FCFLAGS="$FCFLAGS";
+AC_PROG_FC([ftn xlf2003_r xlf2003 xlf95_r xlf95 xlf90 xlf pgf95 pgf90 ifort ifc  nagfor gfortran])
+FCFLAGS="$save_FCFLAGS";
+save_CFLAGS="$CFLAGS";
+AC_PROG_CC([cc xlc pgcc icc gcc ])
+CFLAGS="$save_CFLAGS";
+save_CXXFLAGS="$CXXFLAGS";
+AC_PROG_CXX([CC xlc++  icpc g++])
+CXXFLAGS="$save_CXXFLAGS";
+dnl AC_PROG_CXX
+
+dnl AC_PROG_F90 doesn't exist, at the time of writing this !
+dnl AC_PROG_F90
+
+# Sanity checks, although redundant (useful when debugging this configure.ac)!
+if test "X$FC" == "X" ; then
+	AC_MSG_ERROR([Problem : No Fortran compiler specified nor found!])
+fi
+
+if eval "$FC -qversion 2>&1 | grep XL 2>/dev/null" ; then
+	# Some configurations of the XLF want "-WF," prepended to -D.. flags.
+	# TODO : discover the exact conditions when the usage of -WF is needed.
+	amg_cv_define_prepend="-WF,"
+        if eval "$MPIFC -qversion 2>&1 | grep -e\"Version: 10\.\" 2>/dev/null"; then
+        	FDEFINES="$amg_cv_define_prepend-DXLF_10 $FDEFINES"		  
+        fi
+
+ # Note : there could be problems with old xlf compiler versions ( <10.1 )
+ # since (as far as it is known to us) -WF, is not used in earlier versions.
+ # More problems could be undocumented yet.
+fi 
+
+if test "X$CC" == "X" ; then
+	AC_MSG_ERROR([Problem : No C compiler specified nor found!])
+fi
+AC_PROG_CC_STDC()
+if test "x$ac_cv_prog_cc_stdc" == "xno" ; then
+   AC_MSG_ERROR([Problem : Need a C99 compiler ! ])
+else
+   C99OPT="$ac_cv_prog_cc_stdc";
+fi	
+###############################################################################
+#			Suitable MPI compilers detection
+###############################################################################
+# Note: Someday we will contemplate a fake MPI - configured version of PSBLAS
+###############################################################################
+# First check whether the user required our serial (fake) mpi.
+PAC_ARG_SERIAL_MPI
+
+#Note : we miss the name of the Intel C compiler
+if test x"$pac_cv_serial_mpi" == x"yes" ; then
+   FAKEMPI="fakempi.o";
+   MPIFC="$FC";
+   MPICC="$CC";
+   MPICXX="$CXX";	
+   CXXDEFINES="-DSERIAL_MPI $CXXDEFINES";
+
+else 
+AC_LANG([C])
+if test "X$MPICC" = "X" ; then
+    # This is our MPICC compiler preference: it will override ACX_MPI's first try.
+    AC_CHECK_PROGS([MPICC],[mpxlc mpiicc mpcc mpicc cc])
+fi
+ACX_MPI([], [AC_MSG_ERROR([[Cannot find any suitable MPI implementation for C]])])
+
+
+AC_LANG([Fortran])
+
+if test "X$MPIFC" = "X" ; then
+    # This is our MPIFC compiler preference: it will override ACX_MPI's first try.
+    AC_CHECK_PROGS([MPIFC],[mpxlf2003_r mpxlf2003 mpxlf95_r mpxlf90  mpiifort mpf95 mpf90 mpifort mpif95 mpif90 ftn ])
+fi
+
+ACX_MPI([], [AC_MSG_ERROR([[Cannot find any suitable MPI implementation for Fortran]])])
+AC_LANG([C++])
+if test "X$MPICXX" = "X" ; then
+    # This is our MPICC compiler preference: it will override ACX_MPI's first try.
+    AC_CHECK_PROGS([MPICXX],[mpxlc++ mpiicpc  mpicxx])
+fi
+ACX_MPI([], [AC_MSG_ERROR([[Cannot find any suitable MPI implementation for C++]])])
+AC_LANG([Fortran])
+
+FC="$MPIFC" ;
+CC="$MPICC";
+CXX="$MPICXX";
+fi
+
+AC_LANG([C])
+
+dnl Now on, MPIFC should be set, and MPICC
+
+###############################################################################
+# Sanity checks, although redundant (useful when debugging this configure.ac)!
+###############################################################################
+
+if test "X$MPIFC" == "X" ; then
+	AC_MSG_ERROR([Problem : No MPI Fortran compiler specified nor found!])
+fi
+
+if test "X$MPICC" == "X" ; then
+	AC_MSG_ERROR([Problem : No MPI C compiler specified nor found!])
+fi
+
+###############################################################################
+# 			FLAGS and LIBS user customization
+###############################################################################
+
+dnl NOTE : no spaces before the comma, and no brackets before the second argument!
+PAC_ARG_WITH_FLAGS(ccopt,CCOPT)
+PAC_ARG_WITH_FLAGS(cxxopt,CXXOPT)
+PAC_ARG_WITH_FLAGS(fcopt,FCOPT)
+PAC_ARG_WITH_LIBS
+PAC_ARG_WITH_FLAGS(clibs,CLIBS)
+PAC_ARG_WITH_FLAGS(flibs,FLIBS)
+PAC_ARG_WITH_FLAGS(cxxlibs,CXXLIBS)
+
+dnl candidates for removal:
+PAC_ARG_WITH_FLAGS(library-path,LIBRARYPATH)
+PAC_ARG_WITH_FLAGS(include-path,INCLUDEPATH)
+PAC_ARG_WITH_FLAGS(module-path,MODULE_PATH)
+
+# we just gave the user the chance to append values to these variables
+PAC_ARG_WITH_EXTRA_LIBS
+
+###############################################################################
+# Sanity checks, although redundant (useful when debugging this configure.ac)!
+###############################################################################
+
+###############################################################################
+#	Compiler identification (sadly, it is necessary)
+###############################################################################
+psblas_cv_fc=""
+
+dnl Do we use gfortran & co ? Compiler identification.
+dnl NOTE : in /autoconf/autoconf/fortran.m4 there are plenty of better tests!
+
+PAC_CHECK_HAVE_GFORTRAN(
+	[psblas_cv_fc="gcc"],
+)
+
+PAC_CHECK_HAVE_CRAYFTN(
+	[psblas_cv_fc="cray"],
+)
+
+if test x"$psblas_cv_fc" == "x" ; then
+ if eval "$MPIFC -qversion 2>&1 | grep XL 2>/dev/null" ; then
+	psblas_cv_fc="xlf"
+	# Some configurations of the XLF want "-WF," prepended to -D.. flags.
+	# TODO : discover the exact conditions when the usage of -WF is needed.
+	psblas_cv_define_prepend="-WF,"
+        if eval "$MPIFC -qversion 2>&1 | grep -e\"Version: 10\.\" 2>/dev/null"; then
+        	FDEFINES="$psblas_cv_define_prepend-DXLF_10 $FDEFINES"		  
+        fi
+
+ # Note : there could be problems with old xlf compiler versions ( <10.1 )
+ # since (as far as it is known to us) -WF, is not used in earlier versions.
+ # More problems could be undocumented yet.
+ elif eval "$MPIFC -V  2>&1 | grep Sun 2>/dev/null" ; then
+   # Sun compiler detection
+  
+   psblas_cv_fc="sun"
+ elif eval "$MPIFC -V  2>&1 | grep Portland 2>/dev/null" ; then
+   # Portland group compiler detection
+   
+   psblas_cv_fc="pg"
+ elif eval "$MPIFC -V 2>&1 | grep Intel.*Fortran.*Compiler 2>/dev/null" ; then
+   # Intel compiler identification
+    
+   psblas_cv_fc="ifc"
+ elif eval "$MPIFC -v  2>&1 | grep NAG 2>/dev/null" ; then
+   psblas_cv_fc="nag"
+   FC="$MPIFC"
+ else
+   psblas_cv_fc=""
+  # unsupported MPI Fortran compiler
+     AC_MSG_NOTICE([[Unknown Fortran compiler, proceeding with fingers crossed !]])
+ fi
+fi
+if test "X$psblas_cv_fc" == "Xgcc" ; then
+PAC_HAVE_MODERN_GFORTRAN(
+	[],
+        [AC_MSG_ERROR([Bailing out.])]
+)
+fi
+
+
+###############################################################################
+#	Linking, symbol mangling, and misc tests
+###############################################################################
+
+# Note : This is functional to Make.inc rules and structure (see below).
+AC_LANG([C])
+AC_CHECK_SIZEOF(void *)
+# Define for platforms with 64 bit (void *     ) pointers
+if test X"$ac_cv_sizeof_void_p" == X"8" ; then
+  CDEFINES="-DPtr64Bits $CDEFINES"
+fi
+AC_LANG([Fortran])
+__AC_FC_NAME_MANGLING
+if test "X$psblas_cv_fc" == X"pg" ; then
+   FC=$save_FC
+fi
+AC_LANG([C])
+dnl AC_MSG_NOTICE([Fortran name mangling: $ac_cv_fc_mangling])
+[pac_fc_case=${ac_cv_fc_mangling%%,*}]
+[pac_fc_under=${ac_cv_fc_mangling#*,}]
+[pac_fc_sec_under=${pac_fc_under#*,}]
+[pac_fc_sec_under=${pac_fc_sec_under# }]
+[pac_fc_under=${pac_fc_under%%,*}]
+[pac_fc_under=${pac_fc_under# }]
+AC_MSG_CHECKING([defines for C/Fortran name interfaces])
+if test "x$pac_fc_case" == "xlower case"; then
+   if test "x$pac_fc_under" == "xunderscore"; then
+      if test "x$pac_fc_sec_under" == "xno extra underscore"; then 
+          pac_f_c_names="-DLowerUnderscore"
+      elif test "x$pac_fc_sec_under" == "xextra underscore"; then
+          pac_f_c_names="-DLowerDoubleUnderscore"
+      else
+          pac_f_c_names="-DUNKNOWN"
+dnl  AC_MSG_NOTICE([Fortran name mangling extra underscore unknown case])	
+      fi
+   elif test "x$pac_fc_under" == "xno underscore"; then
+      pac_f_c_names="-DLowerCase"
+   else		       
+      pac_f_c_names="-DUNKNOWN"
+dnl  AC_MSG_NOTICE([Fortran name mangling underscore unknown case])	
+   fi
+elif test "x$pac_fc_case" == "xupper case"; then
+   if test "x$pac_fc_under" == "xunderscore"; then
+      if test "x$pac_fc_sec_under" == "xno extra underscore"; then 
+          pac_f_c_names="-DUpperUnderscore"
+      elif test "x$pac_fc_sec_under" == "xextra underscore"; then
+          pac_f_c_names="-DUpperDoubleUnderscore"
+      else
+          pac_f_c_names="-DUNKNOWN"
+dnl  AC_MSG_NOTICE([Fortran name mangling extra underscore unknown case])	
+      fi
+   elif test "x$pac_fc_under" == "xno underscore"; then
+      pac_f_c_names="-DUpperCase"
+   else		       
+      pac_f_c_names="-DUNKNOWN"
+dnl  AC_MSG_NOTICE([Fortran name mangling underscore unknown case])	
+   fi
+dnl  AC_MSG_NOTICE([Fortran name mangling UPPERCASE not handled])	
+else
+   pac_f_c_names="-DUNKNOWN"   
+dnl   AC_MSG_NOTICE([Fortran name mangling unknown case])	
+fi
+CDEFINES="$pac_f_c_names $CDEFINES"
+
+AC_MSG_RESULT([ $pac_f_c_names ])
+
+###############################################################################
+# 			Make.inc generation logic
+###############################################################################
+# Honor CFLAGS if they were specified explicitly, but --with-ccopt take precedence
+if test "X$CCOPT" == "X" ; then
+  CCOPT="$CFLAGS";
+fi	
+if test "X$CCOPT" == "X" ; then
+ if test "X$psblas_cv_fc" == "Xgcc" ; then
+ # note that no space should be placed around the equality symbol in assignements
+ # Note : 'native' is valid _only_ on GCC/x86  (32/64 bits)
+   CCOPT="-O3  $CCOPT"
+
+ elif test "X$psblas_cv_fc" == X"xlf" ; then
+   # XL compiler : consider using -qarch=auto
+     CCOPT="-O3 -qarch=auto $CCOPT"
+ elif test "X$psblas_cv_fc" == X"ifc" ; then
+   # other compilers ..
+     CCOPT="-O3 $CCOPT"
+ elif test "X$psblas_cv_fc" == X"pg" ; then
+   # other compilers ..
+     CCOPT="-fast $CCOPT"
+  # NOTE : PG & Sun use -fast instead -O3
+ elif test "X$psblas_cv_fc" == X"sun" ; then
+   # other compilers ..
+     CCOPT="-fast $CCOPT"
+ elif test "X$psblas_cv_fc" == X"cray" ; then
+     CCOPT="-O3 $CCOPT"
+     MPICC="cc"
+ elif test "X$psblas_cv_fc" == X"nag" ; then
+   # using GCC in conjunction with NAG.
+     CCOPT="-O2"
+ else 
+     CCOPT="-O2 $CCOPT"
+ fi
+fi
+#CFLAGS="${CCOPT}"
+if test "X$CXXOPT" == "X" ; then
+  CXXOPT="$CXXFLAGS";
+fi	
+if test "X$CXXOPT" == "X" ; then
+ if test "X$psblas_cv_fc" == "Xgcc" ; then
+ # note that no space should be placed around the equality symbol in assignements
+ # Note : 'native' is valid _only_ on GCC/x86  (32/64 bits)
+   CXXOPT="-g -O3  $CXXOPT"
+
+ elif test "X$psblas_cv_fc" == X"xlf" ; then
+   # XL compiler : consider using -qarch=auto
+     CXXOPT="-O3 -qarch=auto $CXXOPT"
+ elif test "X$psblas_cv_fc" == X"ifc" ; then
+   # other compilers ..
+     CXXOPT="-O3 $CXXOPT"
+ elif test "X$psblas_cv_fc" == X"pg" ; then
+   # other compilers ..
+     CXXCOPT="-fast $CXXOPT"
+  # NOTE : PG & Sun use -fast instead -O3
+ elif test "X$psblas_cv_fc" == X"sun" ; then
+   # other compilers ..
+     CXXOPT="-fast $CXXOPT"
+ elif test "X$psblas_cv_fc" == X"cray" ; then
+     CXXOPT="-O3 $CXXOPT"
+     MPICXX="CC"
+ else 
+     CXXOPT="-g -O3 $CXXOPT"
+ fi
+fi
+
+
+# Honor FCFLAGS if they were specified explicitly, but --with-fcopt take precedence
+if test "X$FCOPT" == "X" ; then
+  FCOPT="$FCFLAGS";
+fi	
+if test "X$FCOPT" == "X" ; then
+ if test "X$psblas_cv_fc" == "Xgcc" ; then
+ # note that no space should be placed around the equality symbol in assignations
+ # Note : 'native' is valid _only_ on GCC/x86  (32/64 bits)
+   FCOPT="-O3  $FCOPT"
+ elif test "X$psblas_cv_fc" == X"xlf" ; then
+   # XL compiler : consider using -qarch=auto
+     FCOPT="-O3 -qarch=auto  -qlanglvl=extended -qxlf2003=polymorphic:autorealloc $FCOPT"
+     FCFLAGS="-qhalt=e -qlanglvl=extended -qxlf2003=polymorphic:autorealloc $FCFLAGS"
+ elif test "X$psblas_cv_fc" == X"ifc" ; then
+   # other compilers ..
+     FCOPT="-O3 $FCOPT"
+ elif test "X$psblas_cv_fc" == X"pg" ; then
+   # other compilers ..
+     FCOPT="-fast $FCOPT"
+  # NOTE : PG & Sun use -fast instead -O3
+ elif test "X$psblas_cv_fc" == X"sun" ; then
+   # other compilers ..
+     FCOPT="-fast $FCOPT"
+ elif test "X$psblas_cv_fc" == X"cray" ; then
+     FCOPT="-O3 -em $FCOPT"
+ elif test "X$psblas_cv_fc" == X"nag" ; then
+   # NAG  compiler ..
+     FCOPT="-O2 "
+  # NOTE : PG & Sun use -fast instead -O3
+ else 
+     FCOPT="-O2 $FCOPT"
+ fi
+fi
+if test "X$psblas_cv_fc" == X"nag" ; then
+   # Add needed options 
+     FCOPT="$FCOPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv"
+     EXTRA_OPT="-mismatch_all"
+fi
+
+
+# COPT,FCOPT are aliases for CFLAGS,FCFLAGS .
+
+##############################################################################
+# Compilers variables selection 
+##############################################################################
+FC=${FC}
+CC=${CC}
+CXX=${CXX}
+CCOPT="$CCOPT $C99OPT"
+
+
+##############################################################################
+# Choice of our compilers, needed by Make.inc
+##############################################################################
+if test "X$psblas_cv_fc" == X"cray" 
+then
+   MODEXT=".mod"
+   FMFLAG="-I"
+   FIFLAG="-I"
+   BASEMODNAME=PSB_BASE_MOD
+   PRECMODNAME=PSB_PREC_MOD
+   METHDMODNAME=PSB_KRYLOV_MOD
+   UTILMODNAME=PSB_UTIL_MOD
+
+else 
+   AX_F90_MODULE_EXTENSION
+   AX_F90_MODULE_FLAG
+   MODEXT=".$ax_cv_f90_modext"
+   FMFLAG="${ax_cv_f90_modflag%%[ ]*}"
+   FIFLAG=-I
+   BASEMODNAME=psb_base_mod
+   PRECMODNAME=psb_prec_mod
+   METHDMODNAME=psb_krylov_mod
+   UTILMODNAME=psb_util_mod
+fi
+
+
+##############################################################################
+# Choice of our compilers, needed by Make.inc
+##############################################################################
+if test "X$FLINK" == "X" ; then
+   FLINK=${MPF90}
+fi
+# Custom test : do we have a module or include for MPI Fortran interface?
+if test x"$pac_cv_serial_mpi" == x"yes" ; then
+   FDEFINES="$psblas_cv_define_prepend-DSERIAL_MPI $psblas_cv_define_prepend-DMPI_MOD $FDEFINES";
+else 
+ PAC_FORTRAN_CHECK_HAVE_MPI_MOD_F08()
+ if test x"$pac_cv_mpi_f08" == x"yes" ; then
+dnl    FDEFINES="$psblas_cv_define_prepend-DMPI_MOD_F08 $FDEFINES";
+    FDEFINES="$psblas_cv_define_prepend-DMPI_MOD $FDEFINES";
+  else					     	     
+    PAC_FORTRAN_CHECK_HAVE_MPI_MOD(
+ 	  [FDEFINES="$psblas_cv_define_prepend-DMPI_MOD $FDEFINES"],
+	  [FDEFINES="$psblas_cv_define_prepend-DMPI_H $FDEFINES"])	  
+ fi
+fi
+
+FLINK="$MPIFC"
+PAC_ARG_OPENMP()
+if test x"$pac_cv_openmp" == x"yes" ; then
+   FDEFINES="$psblas_cv_define_prepend-DOPENMP $FDEFINES";
+   CDEFINES="-DOPENMP $CDEFINES";	
+   FCOPT="$FCOPT $pac_cv_openmp_fcopt";
+   CCOPT="$CCOPT $pac_cv_openmp_ccopt";
+   FLINK="$FLINK $pac_cv_openmp_fcopt";
+fi
+
+PAC_FORTRAN_HAVE_PSBLAS([AC_MSG_RESULT([yes.])],
+	[AC_MSG_ERROR([no.  Could not find working version of PSBLAS.])])
+
+PAC_FORTRAN_PSBLAS_VERSION()
+
+if test "x$pac_cv_psblas_major" == "xunknown"; then
+  AC_MSG_ERROR([PSBLAS version major "$pac_cv_psblas_major".])
+fi
+if test "x$pac_cv_psblas_minor" == "xunknown"; then
+   AC_MSG_ERROR([PSBLAS version minor "$pac_cv_psblas_minor".])
+fi
+if test "x$pac_cv_psblas_patchlevel" == "xunknown"; then
+   AC_MSG_ERROR([PSBLAS patchlevel "$pac_cv_psblas_patchlevel".])
+fi
+if (( $pac_cv_psblas_major < 3 )) ||
+   (  (( $pac_cv_psblas_major == 3 )) && (( $pac_cv_psblas_minor < 7 ))) ; then
+  AC_MSG_ERROR([I need at least PSBLAS version 3.7.]) 
+else
+  AC_MSG_NOTICE([Am configuring with PSBLAS version $pac_cv_psblas_major.$pac_cv_psblas_minor.$pac_cv_psblas_patchlevel.])
+fi
+
+PAC_ARG_WITH_IPK
+PAC_ARG_WITH_LPK
+# Defaults for IPK/LPK
+if test x"$pac_cv_ipk_size" == x"" ; then
+  pac_cv_ipk_size=4
+fi
+if test x"$pac_cv_lpk_size" == x"" ; then
+  pac_cv_lpk_size=8
+fi
+# Enforce sensible combination
+if (( $pac_cv_lpk_size < $pac_cv_ipk_size )); then
+   AC_MSG_NOTICE([[Invalid combination of size specs IPK ${pac_cv_ipk_size} LPK ${pac_cv_lpk_size}. ]]);
+   AC_MSG_NOTICE([[Forcing equal values]])	
+   pac_cv_lpk_size=$pac_cv_ipk_size;	
+fi				
+FDEFINES="$psblas_cv_define_prepend-DIPK${pac_cv_ipk_size} $FDEFINES";
+FDEFINES="$psblas_cv_define_prepend-DLPK${pac_cv_lpk_size} $FDEFINES";	
+CDEFINES="-DIPK${pac_cv_ipk_size} -DLPK${pac_cv_lpk_size} $CDEFINES"; 
+if test x"$pac_cv_lpk_size" == x8"" ; then
+  CXXDEFINES="-DBIT64 $CXXDEFINES";
+fi
+
+###############################################################################
+#	Parachute rules for ar and ranlib ... (could cause problems)
+###############################################################################
+
+if test "X$AR" == "X" ; then
+  AR="ar"
+fi
+
+if test "X$RANLIB" == "X" ; then
+  RANLIB="ranlib"
+fi
+
+# This should be portable
+AR="${AR} -cur"
+
+
+###############################################################################
+# NOTE :
+# Missing stuff : 
+# 		In the case the detected fortran compiler is ifort, icc or gcc
+#		should be valid options.
+#		The same for pg (Portland Group compilers).
+###############################################################################
+
+#
+# Tests for support of various Fortran features; some of them are critical,
+# some optional
+#
+
+#
+# Critical features
+#
+
+PAC_FORTRAN_TEST_EXTENDS( 
+	[],
+        [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for EXTENDS. 
+ Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
+)
+
+PAC_FORTRAN_TEST_CLASS_TBP( 
+	[],
+        [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for CLASS and type bound procedures. 
+ Please get a Fortran compiler that supports them, e.g. GNU Fortran 4.8.])]
+)
+
+PAC_FORTRAN_TEST_SOURCE( 
+	[],
+        [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for SOURCE= allocation. 
+ Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
+)
+
+PAC_FORTRAN_HAVE_MOVE_ALLOC(
+	[],
+        [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for MOVE_ALLOC. 
+ Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
+)
+
+PAC_FORTRAN_TEST_ISO_C_BIND( 
+	[],
+        [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for ISO_C_BINDING. 
+ Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
+)
+
+PAC_FORTRAN_TEST_SAME_TYPE( 
+	[],
+        [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for SAME_TYPE_AS. 
+ Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
+)
+
+PAC_FORTRAN_TEST_EXTENDS_TYPE( 
+	[],
+        [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for EXTENDS_TYPE_OF. 
+ Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
+)
+
+PAC_FORTRAN_TEST_MOLD( 
+	[],
+        [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for MOLD= allocation. 
+ Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
+)
+
+PAC_FORTRAN_TEST_VOLATILE(
+	[],
+        [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for	VOLATILE])]	
+)
+
+PAC_FORTRAN_TEST_ISO_FORTRAN_ENV(
+	[],
+        [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for	ISO_FORTRAN_ENV])]	
+)
+
+PAC_FORTRAN_TEST_FINAL( 
+	[],
+        [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for FINAL])]	
+)
+
+
+#
+# Optional features
+#
+
+
+PAC_FORTRAN_TEST_GENERICS( 
+	[],
+	[FDEFINES="$psblas_cv_define_prepend-DHAVE_BUGGY_GENERICS $FDEFINES"]
+)
+
+PAC_FORTRAN_TEST_FLUSH( 
+	[FDEFINES="$psblas_cv_define_prepend-DHAVE_FLUSH_STMT $FDEFINES"],
+)
+
+
+###############################################################################
+#	Additional pathname stuff (yes, it is redundant and confusing...)
+###############################################################################
+
+# -I
+if test x"$INCLUDEPATH" != "x" ; then
+	FINCLUDES="$FINCLUDES $INCLUDEPATH"
+	CINCLUDES="$CINCLUDES $INCLUDEPATH"
+fi
+
+# -L
+if test x"$LIBRARYPATH" != "x" ; then
+	FINCLUDES="$FINCLUDES $LIBRARYPATH"
+fi
+
+# -I
+if test x"$MODULE_PATH" != "x" ; then
+	FINCLUDES="$FINCLUDES $MODULE_PATH"
+fi
+
+
+###############################################################################
+#		BLAS  library presence checks
+###############################################################################
+
+# Note : The libmkl.a (Intel Math Kernel Library) library could be used, too.
+# It is sufficient to specify it as -lmkl in the CLIBS or FLIBS or LIBS 
+# and specify its path adjusting -L/path in CFLAGS.
+
+# Right now it is a matter of user's taste when linking custom applications.
+# But PSBLAS examples could take advantage of these libraries, too.
+AC_LANG([Fortran])
+###############################################################################
+#		BLAS  library presence checks
+###############################################################################
+
+# Note : The libmkl.a (Intel Math Kernel Library) library could be used, too.
+# It is sufficient to specify it as -lmkl in the CLIBS or FLIBS or LIBS 
+# and specify its path adjusting -L/path in CFLAGS.
+
+# Right now it is a matter of user's taste when linking custom applications.
+# But PSBLAS examples could take advantage of these libraries, too.
+
+PAC_BLAS([], [AC_MSG_ERROR([[Cannot find BLAS library, specify a path using --with-blas=DIR/LIB (for example --with-blas=/usr/path/lib/libcxml.a)]])])
+PAC_LAPACK(
+[FDEFINES="$psblas_cv_define_prepend-DHAVE_LAPACK $FDEFINES"],
+)
+AC_LANG([C])
+
+
+###############################################################################
+#		BLACS library presence checks
+###############################################################################
+#AC_LANG([C])
+#if test x"$pac_cv_serial_mpi" == x"no" ; then
+#save_FC="$FC";
+#save_CC="$CC";
+#FC="$MPIFC";
+#CC="$MPICC";
+#PAC_CHECK_BLACS
+#FC="$save_FC";
+#CC="$save_CC";
+#fi
+
+PAC_MAKE_IS_GNUMAKE
+###############################################################################
+#		Auxiliary packages
+###############################################################################
+
+PAC_CHECK_METIS
+
+AC_MSG_CHECKING([Compatibility between metis and LPK])
+if  test  "x$pac_cv_lpk_size" == "x4" ; then
+  if test  "x$pac_cv_metis_idx" == "x64" ; then
+  dnl mismatch between metis size and PSBLAS LPK
+       psblas_cv_have_metis="no";
+ dnl 
+   fi
+ fi			   
+ if test "x$pac_cv_lpk_size" == "x8" ; then
+   if test "x$pac_cv_metis_idx" == "x32" ; then 
+   dnl mismatch between metis size and PSBLAS LPK
+      psblas_cv_have_metis="no";
+   fi
+ fi			   
+AC_MSG_RESULT([$psblas_cv_have_metis])
+
+if test "x$pac_cv_metis_idx" == "xunknown" ; then
+  dnl mismatch between metis size and PSBLAS LPK
+     AC_MSG_NOTICE([Unknown  METIS bitsize.])	
+     $psblas_cv_have_metis = "no";
+fi		   
+if test "x$pac_cv_metis_real" == "xunknown" ; then
+  dnl mismatch between metis size and PSBLAS LPK
+     AC_MSG_NOTICE([Unknown  METIS REAL bitsize.])	
+     $psblas_cv_have_metis = "no";
+fi		   
+if test "x$psblas_cv_have_metis" == "xyes" ; then 
+   FDEFINES="$psblas_cv_define_prepend-DHAVE_METIS $psblas_cv_define_prepend-DMETIS_$pac_cv_metis_idx $psblas_cv_define_prepend-DMETIS_REAL_$pac_cv_metis_real $FDEFINES"
+   CDEFINES="-DHAVE_METIS_ $psblas_cv_metis_includes $CDEFINES -DMETIS_$pac_cv_metis_idx -DMETIS_REAL_$pac_cv_metis_real"
+   METISINCFILE=$psblas_cv_metisincfile
+fi
+
+
+PAC_CHECK_MUMPS
+#
+#    1. Enable even with LPK=8, internally it will check if
+#    	the problem size fits into 4 bytes, very likely since we
+#    	are mostly using MUMPS at coarse level.
+#
+dnl if test "x$amg4psblas_cv_have_mumps" == "xyes" ; then
+dnl    if test "x$pac_cv_psblas_ipk" == "x8" ; then
+dnl       AC_MSG_NOTICE([PSBLAS defines PSB_IPK_ as $pac_cv_psblas_ipk. MUMPS interfacing disabled. ])
+dnl       MUMPS_FLAGS="";
+dnl       MUMPS_LIBS="";
+dnl       amg4psblas_cv_have_mumps=no;
+dnl    fi
+dnl fi   
+if test "x$amg4psblas_cv_have_mumps" == "xyes" ; then
+   if test "x$pac_cv_psblas_lpk" == "x8" ; then
+      AC_MSG_NOTICE([PSBLAS defines PSB_LPK_ as $pac_cv_psblas_lpk. MUMPS interfacing will fail when called in global mode on very large matrices. ])
+   fi	
+   if test "x$pac_mumps_fmods_ok" == "xyes" ; then 
+      FDEFINES="$amg_cv_define_prepend-DHAVE_MUMPS_ $amg_cv_define_prepend-DHAVE_MUMPS_MODULES_ $MUMPS_MODULES $FDEFINES"
+       MUMPS_FLAGS="-DHave_MUMPS_ $MUMPS_MODULES"
+   elif test "x$pac_mumps_fincs_ok" == "xyes" ; then
+      FDEFINES="$amg_cv_define_prepend-DHAVE_MUMPS_ $amg_cv_define_prepend-DHAVE_MUMPS_INCLUDES_ $MUMPS_FINCLUDES $FDEFINES"
+       MUMPS_FLAGS="-DHave_MUMPS_ $MUMPS_INCLUDES"
+   else
+      # This should not happen
+      MUMPS_FLAGS=""
+      MUMPS_LIBS=""
+   fi
+else
+   MUMPS_FLAGS=""
+   MUMPS_LIBS=""
+fi
+
+PAC_CHECK_UMFPACK
+if test "x$amg4psblas_cv_have_umfpack" == "xyes" ; then 
+   UMF_FLAGS="-DHave_UMF_ $UMF_INCLUDES"
+   FDEFINES="$amg_cv_define_prepend-DHAVE_UMF_ $FDEFINES"
+else
+   UMF_FLAGS=""
+fi
+
+PAC_CHECK_SUPERLU
+if test "x$amg4psblas_cv_have_superlu" == "xyes" ; then 
+   SLU_FLAGS="-DHave_SLU_ -DSLU_VERSION_$pac_slu_version $SLU_INCLUDES"
+   FDEFINES="$amg_cv_define_prepend-DHAVE_SLU_ $FDEFINES"
+else
+   SLU_FLAGS=""
+fi
+
+PAC_CHECK_SUPERLUDIST()
+
+if test "x$amg4psblas_cv_have_superludist" == "xyes" ; then
+   pac_sludist_version="$amg4psblas_cv_superludist_major";      
+   if (($amg4psblas_cv_superludist_major==6)); then
+      if (($amg4psblas_cv_superludist_minor>=3)); then
+        pac_sludist_version="63";
+      fi
+   fi	
+   SLUDIST_FLAGS=""	       
+   SLUDIST_FLAGS="-DHave_SLUDist_ -DSLUD_VERSION_$pac_sludist_version $SLUDIST_INCLUDES"
+   FDEFINES="$amg_cv_define_prepend-DHAVE_SLUDIST_ $FDEFINES"
+else
+   SLUDIST_FLAGS=""
+fi
+
+##############################################
+FINCLUDES="$PSBLAS_INCLUDES"
+
+AMGFDEFINES="$FDEFINES"
+AMGCDEFINES="$CDEFINES"
+AMGCXXDEFINES="$CXXDEFINES"
+
+LIBDIR=lib
+BASELIBNAME=libpsb_base.a
+PRECLIBNAME=libpsb_prec.a
+METHDLIBNAME=libpsb_krylov.a
+UTILLIBNAME=libpsb_util.a
+AMGLIBNAME=libamg_prec.a
+
+COMPILERULES='
+PSBLDLIBS=$(LAPACK) $(BLAS) $(METIS_LIB) $(AMD_LIB) $(LIBS)
+CXXDEFINES=$(PSBCXXDEFINES)
+CDEFINES=$(PSBCDEFINES)
+FDEFINES=$(PSBFDEFINES)
+	
+
+# These should be portable rules, arent they?
+.c.o:
+	$(CC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $< -o $@
+.f90.o:
+	$(FC) $(FCOPT) $(FINCLUDES) -c $< -o $@
+.F90.o:
+	$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $< -o $@
+.cpp.o:
+	$(CXX) $(CXXOPT) $(CXXINCLUDES) $(CXXDEFINES) -c $< -o $@'
+###############################################################################
+# Variable substitutions : the Make.inc.in will have these @VARIABLES@
+# substituted.
+
+AC_SUBST(PSBLAS_DIR)
+AC_SUBST(PSBLAS_INCDIR)
+AC_SUBST(PSBLAS_MODDIR)
+AC_SUBST(PSBLAS_LIBDIR)
+AC_SUBST(PSBLAS_INCLUDES)
+dnl AC_SUBST(PSBLAS_INSTALL_MAKEINC)
+AC_SUBST(PSBLAS_LIBS)
+AC_SUBST(PSBLAS_RULES)
+
+AC_SUBST(INSTALL)
+AC_SUBST(INSTALL_DATA)
+AC_SUBST(INSTALL_DIR)
+AC_SUBST(INSTALL_LIBDIR)
+AC_SUBST(INSTALL_INCLUDEDIR)
+AC_SUBST(INSTALL_MODULESDIR)
+AC_SUBST(INSTALL_DOCSDIR)
+AC_SUBST(INSTALL_SAMPLESDIR)
+
+AC_SUBST(EXTRA_LIBS)
+AC_SUBST(BLAS_LIBS)
+AC_SUBST(LAPACK_LIBS)
+AC_SUBST(METIS_LIBS)
+AC_SUBST(MUMPS_FLAGS)
+AC_SUBST(MUMPS_LIBS)
+AC_SUBST(SLU_FLAGS)
+AC_SUBST(SLU_LIBS)
+AC_SUBST(UMF_FLAGS)
+AC_SUBST(UMF_LIBS)
+AC_SUBST(SLUDIST_FLAGS)
+AC_SUBST(SLUDIST_LIBS)
+AC_SUBST(AMGFDEFINES)
+AC_SUBST(AMGCDEFINES)
+AC_SUBST(AMGCXXDEFINES)
+AC_SUBST(MODEXT)
+AC_SUBST(COMPILERULES)
+AC_SUBST(FDEFINES)
+AC_SUBST(CDEFINES)
+AC_SUBST(BASEMODNAME)
+AC_SUBST(PRECMODNAME)
+AC_SUBST(METHDMODNAME)
+AC_SUBST(UTILMODNAME)
+AC_SUBST(AMGLIBNAME)
+AC_SUBST(MPIFC)
+AC_SUBST(MPICC)
+AC_SUBST(MPICXX)
+AC_SUBST(FCOPT)
+AC_SUBST(CCOPT)
+AC_SUBST(CXXOPT)
+AC_SUBST(EXTRA_OPT)
+AC_SUBST(FAKEMPI)
+AC_SUBST(FIFLAG)
+AC_SUBST(FMFLAG)
+AC_SUBST(MODEXT)
+AC_SUBST(FLINK)
+AC_SUBST(LIBS)
+AC_SUBST(AR)
+AC_SUBST(RANLIB)
+AC_SUBST(MPIFC)
+AC_SUBST(MPIFCC)
+
+###############################################################################
+# the following files will be created by Automake
+
+AC_CONFIG_FILES([Make_n.inc])
+AC_OUTPUT()
+
+###############################################################################
+
+dnl Please note that brackets around variable identifiers are absolutely needed for compatibility..
+AC_MSG_NOTICE([
+	${PACKAGE_NAME} ${amg4psblas_cv_version} has been configured as follows:
+
+	PSBLAS library        : ${PSBLAS_DIR}
+	MUMPS detected        : ${amg4psblas_cv_have_mumps}
+	SuperLU detected      : ${amg4psblas_cv_have_superlu}
+	SuperLU_Dist detected : ${amg4psblas_cv_have_superludist}
+	UMFPack detected      : ${amg4psblas_cv_have_umfpack}
+
+	If you are satisfied, run 'make' to build ${PACKAGE_NAME} and its documentation; otherwise
+	type  ./configure --help=short for a complete list of configure options specific to ${PACKAGE_NAME}.
+dnl	To install the program and its documentation, run 'make install' if you are root,
+dnl	or run 'su -c "make install"' if you are not root.
+])
+
+###############################################################################
+