Merge branch 'master' into maint-1.0

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

@@ -81,10 +81,10 @@ module amg_base_prec_type
   !
   ! Version numbers
   !
-  character(len=*), parameter   :: amg_version_string_ = "1.0.0"
+  character(len=*), parameter   :: amg_version_string_ = "1.0.1"
   integer(psb_ipk_), parameter  :: amg_version_major_  = 1
   integer(psb_ipk_), parameter  :: amg_version_minor_  = 0
-  integer(psb_ipk_), parameter  :: amg_patchlevel_     = 0
+  integer(psb_ipk_), parameter  :: amg_patchlevel_     = 1
 
   type amg_ml_parms
     integer(psb_ipk_) :: sweeps_pre, sweeps_post
@@ -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

@@ -68,7 +68,7 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-module dmatchboxp_mod
+module amg_d_matchboxp_mod
 
   use iso_c_binding
   use psb_base_cbind_mod
@@ -94,33 +94,25 @@ module dmatchboxp_mod
     end subroutine dMatchBoxPC
   end interface MatchBoxPC
 
-  interface i_aggr_assign
-    module procedure i_daggr_assign
-  end interface i_aggr_assign
+  interface amg_i_aggr_assign
+    module procedure amg_i_d_aggr_assign
+  end interface amg_i_aggr_assign
 
-  interface build_matching
-    module procedure dbuild_matching
-  end interface build_matching
+  interface amg_par_build_matching
+    module procedure amg_d_par_build_matching
+  end interface amg_par_build_matching
 
-  interface build_ahat
-    module procedure dbuild_ahat
-  end interface build_ahat
+  interface amg_par_build_ahat
+    module procedure amg_d_par_build_ahat
+  end interface amg_par_build_ahat
 
-  interface psb_gtranspose
-    module procedure psb_dgtranspose
-  end interface psb_gtranspose
-
-  interface psb_htranspose
-    module procedure psb_dhtranspose
-  end interface psb_htranspose
-
-  interface PMatchBox
-    module procedure dPMatchBox
-  end interface PMatchBox
+  interface amg_PMatchBox
+    module procedure amg_d_PMatchBox
+  end interface amg_PMatchBox
 
 contains
 
-  subroutine dmatchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
+  subroutine amg_d_matchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
        & symmetrize,reproducible,display_inp, display_out, print_out)
     use psb_base_mod
     use psb_util_mod
@@ -213,7 +205,7 @@ contains
     end if
     if (do_timings) call psb_toc(idx_phase1)
     if (do_timings) call psb_tic(idx_bldmtc)
-    call build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
+    call amg_par_build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
     if (do_timings) call psb_toc(idx_bldmtc)
     if (debug) write(0,*) iam,' buildprol from buildmatching:',&
          & info
@@ -311,7 +303,7 @@ contains
                   ! Should be a symmetric function.
                   !
                   call desc_a%indxmap%qry_halo_owner(idx,iown,info)
-                  ip    = i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
+                  ip    = amg_i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
                   if (iam == ip) then
                     nlaggr(iam) = nlaggr(iam) + 1
                     ilaggr(k)   = nlaggr(iam)
@@ -513,9 +505,9 @@ contains
       write(0,*) iam,' :  error from Matching: ',info
     end if
 
-  end subroutine dmatchboxp_build_prol
+  end subroutine amg_d_matchboxp_build_prol
 
-  function i_daggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
+  function amg_i_d_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
        & result(iproc)
     !
     ! How to break ties? This
@@ -557,10 +549,10 @@ contains
         iproc = iown
       end if
     end if
-  end function i_daggr_assign
+  end function amg_i_d_aggr_assign
 
 
-  subroutine dbuild_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
+  subroutine amg_d_par_build_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
     use psb_base_mod
     use psb_util_mod
     use iso_c_binding
@@ -609,7 +601,7 @@ contains
       if (iam == 0) write(0,*)' Into build_ahat:'
     end if
     if (do_timings) call psb_tic(idx_bldahat)
-    call build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
+    call amg_par_build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
     if (do_timings) call psb_toc(idx_bldahat)
     if (info /= 0) then
       write(0,*) 'Error from build_ahat ', info
@@ -700,7 +692,7 @@ contains
       !
       if (debug) write(0,*) iam,' buildmatching into PMatchBox:'
       if (do_timings) call psb_tic(idx_cmboxp)
-      call PMatchBox(nr,nz,vlptr,vlind,ewght,&
+      call amg_PMatchBox(nr,nz,vlptr,vlind,ewght,&
            & vnl, mate, iam, np,ictxt,&
            & msgis,msgas,msgprc,ph0t,ph1t,ph2t,ph1crd,ph2crd,info,display_inp)
       if (do_timings) call psb_toc(idx_cmboxp)
@@ -764,9 +756,9 @@ contains
       val(1:n) = tmp(1:n)
     end subroutine fix_order
 
-  end subroutine dbuild_matching
+  end subroutine amg_d_par_build_matching
 
-  subroutine dbuild_ahat(w,a,ahat,desc_a,info,symmetrize)
+  subroutine amg_d_par_build_ahat(w,a,ahat,desc_a,info,symmetrize)
     use psb_base_mod
     implicit none
     real(psb_dpk_), intent(in)           :: w(:)
@@ -1002,301 +994,9 @@ contains
       end block
     end if
 
-  end subroutine dbuild_ahat
+  end subroutine amg_d_par_build_ahat
 
-  subroutine psb_dgtranspose(ain,aout,desc_a,info)
-    use psb_base_mod
-    implicit none
-    type(psb_ldspmat_type), intent(in)  :: ain
-    type(psb_ldspmat_type), intent(out) :: aout
-    type(psb_desc_type)           :: desc_a
-    integer(psb_ipk_), intent(out) :: info
-
-    !
-    ! BEWARE: This routine works under the assumption
-    ! that the same DESC_A works for both A and A^T, which
-    ! essentially means that A has a symmetric pattern.
-    !
-    type(psb_ldspmat_type) :: atmp, ahalo, aglb
-    type(psb_ld_coo_sparse_mat) :: tmpcoo
-    type(psb_ld_csr_sparse_mat) :: tmpcsr
-    type(psb_ctxt_type) :: ictxt
-    integer(psb_ipk_) :: me, np
-    integer(psb_lpk_) :: i, j, k, nrow, ncol
-    integer(psb_lpk_), allocatable :: ilv(:)
-    character(len=80) :: aname
-    logical, parameter :: debug=.false., dump=.false., debug_sync=.false.
-
-    ictxt = desc_a%get_context()
-    call psb_info(ictxt,me,np)
-
-    nrow = desc_a%get_local_rows()
-    ncol = desc_a%get_local_cols()
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'Start gtranspose '
-    end if
-    call ain%cscnv(tmpcsr,info)
-
-    if (debug) then
-      ilv = [(i,i=1,ncol)]
-      call desc_a%l2gip(ilv,info,owned=.false.)
-      write(aname,'(a,i3.3,a)') 'atmp-preh-',me,'.mtx'
-      call ain%print(fname=aname,head='atmp before haloTest ',iv=ilv)
-    end if
-    if (dump) then
-      call ain%cscnv(atmp,info)
-      call psb_gather(aglb,atmp,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'aglob-prehalo.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-    !call psb_loc_to_glob(tmpcsr%ja,desc_a,info)
-    call atmp%mv_from(tmpcsr)
-
-    if (debug) then
-      write(aname,'(a,i3.3,a)') 'tmpcsr-',me,'.mtx'
-      call atmp%print(fname=aname,head='tmpcsr ',iv=ilv)
-      !call psb_set_debug_level(9999)
-    end if
-
-    ! FIXME THIS NEEDS REWORKING
-    if (debug) write(0,*) me,' Gtranspose into sphalo :',atmp%get_nrows(),atmp%get_ncols()
-    call psb_sphalo(atmp,desc_a,ahalo,info,rowscale=.true.)
-    if (debug) write(0,*) me,' Gtranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols()
-    if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
-
-    if (debug) then
-      write(aname,'(a,i3.3,a)') 'ahalo-',me,'.mtx'
-      call ahalo%print(fname=aname,head='ahalo after haloTest ',iv=ilv)
-      write(aname,'(a,i3.3,a)') 'atmp-h-',me,'.mtx'
-      call atmp%print(fname=aname,head='atmp after haloTest ',iv=ilv)
-    end if
-
-    if (info == psb_success_) call ahalo%free()
-
-    call atmp%cp_to(tmpcoo)
-    call tmpcoo%transp()
-    !call psb_glob_to_loc(tmpcoo%ia,desc_a,info,iact='I')
-    if (debug) write(0,*) 'Before cleanup:',tmpcoo%get_nzeros()
-
-    j = 0
-    do k=1, tmpcoo%get_nzeros()
-      if ((tmpcoo%ia(k) > 0).and.(tmpcoo%ja(k)>0)) then
-        j = j+1
-        tmpcoo%ia(j)  = tmpcoo%ia(k)
-        tmpcoo%ja(j)  = tmpcoo%ja(k)
-        tmpcoo%val(j) = tmpcoo%val(k)
-      end if
-    end do
-    call tmpcoo%set_nzeros(j)
-
-    if (debug) write(0,*) 'After cleanup:',tmpcoo%get_nzeros()
-
-    call ahalo%mv_from(tmpcoo)
-    if (dump) then
-      call psb_gather(aglb,ahalo,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'atran-preclip.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-
-    call ahalo%csclip(aout,info,imax=nrow)
-
-    if (debug) write(0,*) 'After clip:',aout%get_nzeros()
-
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'End gtranspose '
-    end if
-    !call aout%cscnv(info,type='csr')
-
-    if (dump) then
-      write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx'
-      call aout%print(fname=aname,head='atrans ',iv=ilv)
-      call psb_gather(aglb,aout,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'atran.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-  end subroutine psb_dgtranspose
-
-  subroutine psb_dhtranspose(ain,aout,desc_a,info)
-    use psb_base_mod
-    implicit none
-    type(psb_ldspmat_type), intent(in)  :: ain
-    type(psb_ldspmat_type), intent(out) :: aout
-    type(psb_desc_type)           :: desc_a
-    integer(psb_ipk_), intent(out) :: info
-
-    !
-    ! BEWARE: This routine works under the assumption
-    ! that the same DESC_A works for both A and A^T, which
-    ! essentially means that A has a symmetric pattern.
-    !
-    type(psb_ldspmat_type) :: atmp, ahalo, aglb
-    type(psb_ld_coo_sparse_mat) :: tmpcoo, tmpc1, tmpc2, tmpch
-    type(psb_ld_csr_sparse_mat) :: tmpcsr
-    integer(psb_ipk_) :: nz1, nz2, nzh, nz
-    type(psb_ctxt_type) :: ictxt
-    integer(psb_ipk_) :: me, np
-    integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz
-    integer(psb_lpk_), allocatable :: ilv(:)
-    character(len=80) :: aname
-    logical, parameter :: debug=.false., dump=.false., debug_sync=.false.
-
-    ictxt = desc_a%get_context()
-    call psb_info(ictxt,me,np)
-
-    nrow = desc_a%get_local_rows()
-    ncol = desc_a%get_local_cols()
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'Start htranspose '
-    end if
-    call ain%cscnv(tmpcsr,info)
-
-    if (debug) then
-      ilv = [(i,i=1,ncol)]
-      call desc_a%l2gip(ilv,info,owned=.false.)
-      write(aname,'(a,i3.3,a)') 'atmp-preh-',me,'.mtx'
-      call ain%print(fname=aname,head='atmp before haloTest ',iv=ilv)
-    end if
-    if (dump) then
-      call ain%cscnv(atmp,info)
-      call psb_gather(aglb,atmp,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'aglob-prehalo.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-    !call psb_loc_to_glob(tmpcsr%ja,desc_a,info)
-    call atmp%mv_from(tmpcsr)
-
-    if (debug) then
-      write(aname,'(a,i3.3,a)') 'tmpcsr-',me,'.mtx'
-      call atmp%print(fname=aname,head='tmpcsr ',iv=ilv)
-      !call psb_set_debug_level(9999)
-    end if
-
-    ! FIXME THIS NEEDS REWORKING
-    if (debug) write(0,*) me,' Htranspose into sphalo :',atmp%get_nrows(),atmp%get_ncols()
-    if (.true.) then
-      call psb_sphalo(atmp,desc_a,ahalo,info, outfmt='coo  ')
-      call atmp%mv_to(tmpc1)
-      call ahalo%mv_to(tmpch)
-      nz1 = tmpc1%get_nzeros()
-      call psb_loc_to_glob(tmpc1%ia(1:nz1),desc_a,info,iact='I')
-      call psb_loc_to_glob(tmpc1%ja(1:nz1),desc_a,info,iact='I')
-      nzh = tmpch%get_nzeros()
-      call psb_loc_to_glob(tmpch%ia(1:nzh),desc_a,info,iact='I')
-      call psb_loc_to_glob(tmpch%ja(1:nzh),desc_a,info,iact='I')
-      nlz = nz1+nzh
-      call tmpcoo%allocate(ncol,ncol,nlz)
-      tmpcoo%ia(1:nz1) = tmpc1%ia(1:nz1)
-      tmpcoo%ja(1:nz1) = tmpc1%ja(1:nz1)
-      tmpcoo%val(1:nz1) = tmpc1%val(1:nz1)
-      tmpcoo%ia(nz1+1:nz1+nzh) = tmpch%ia(1:nzh)
-      tmpcoo%ja(nz1+1:nz1+nzh) = tmpch%ja(1:nzh)
-      tmpcoo%val(nz1+1:nz1+nzh) = tmpch%val(1:nzh)
-      call tmpcoo%set_nzeros(nlz)
-      call tmpcoo%transp()
-      nz = tmpcoo%get_nzeros()
-      call psb_glob_to_loc(tmpcoo%ia(1:nz),desc_a,info,iact='I')
-      call psb_glob_to_loc(tmpcoo%ja(1:nz),desc_a,info,iact='I')
-      if (.true.) then
-        call tmpcoo%clean_negidx(info)
-      else
-        j = 0
-        do k=1, tmpcoo%get_nzeros()
-          if ((tmpcoo%ia(k) > 0).and.(tmpcoo%ja(k)>0)) then
-            j = j+1
-            tmpcoo%ia(j)  = tmpcoo%ia(k)
-            tmpcoo%ja(j)  = tmpcoo%ja(k)
-            tmpcoo%val(j) = tmpcoo%val(k)
-          end if
-        end do
-        call tmpcoo%set_nzeros(j)
-      end if
-      call ahalo%mv_from(tmpcoo)
-      call ahalo%csclip(aout,info,imax=nrow)
-
-    else
-      call psb_sphalo(atmp,desc_a,ahalo,info, rowscale=.true.)
-      if (debug) write(0,*) me,' Htranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols()
-      if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
-
-      if (debug) then
-        write(aname,'(a,i3.3,a)') 'ahalo-',me,'.mtx'
-        call ahalo%print(fname=aname,head='ahalo after haloTest ',iv=ilv)
-        write(aname,'(a,i3.3,a)') 'atmp-h-',me,'.mtx'
-        call atmp%print(fname=aname,head='atmp after haloTest ',iv=ilv)
-      end if
-
-      if (info == psb_success_) call ahalo%free()
-
-      call atmp%cp_to(tmpcoo)
-      call tmpcoo%transp()
-      if (debug) write(0,*) 'Before cleanup:',tmpcoo%get_nzeros()
-      if (.true.) then
-        call tmpcoo%clean_negidx(info)
-      else
-
-        j = 0
-        do k=1, tmpcoo%get_nzeros()
-          if ((tmpcoo%ia(k) > 0).and.(tmpcoo%ja(k)>0)) then
-            j = j+1
-            tmpcoo%ia(j)  = tmpcoo%ia(k)
-            tmpcoo%ja(j)  = tmpcoo%ja(k)
-            tmpcoo%val(j) = tmpcoo%val(k)
-          end if
-        end do
-        call tmpcoo%set_nzeros(j)
-      end if
-
-      if (debug) write(0,*) 'After cleanup:',tmpcoo%get_nzeros()
-
-      call ahalo%mv_from(tmpcoo)
-      if (dump) then
-        call psb_gather(aglb,ahalo,desc_a,info)
-        if (me==psb_root_) then
-          write(aname,'(a,i3.3,a)') 'atran-preclip.mtx'
-          call aglb%print(fname=aname,head='Test ')
-        end if
-      end if
-
-
-      call ahalo%csclip(aout,info,imax=nrow)
-    end if
-
-    if (debug) write(0,*) 'After clip:',aout%get_nzeros()
-
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'End htranspose '
-    end if
-    !call aout%cscnv(info,type='csr')
-
-    if (dump) then
-      write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx'
-      call aout%print(fname=aname,head='atrans ',iv=ilv)
-      call psb_gather(aglb,aout,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'atran.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-  end subroutine psb_dhtranspose
-
-  subroutine dPMatchBox(nlver,nledge,verlocptr,verlocind,edgelocweight,&
+  subroutine amg_d_PMatchBox(nlver,nledge,verlocptr,verlocind,edgelocweight,&
        & verdistance, mate, myrank, numprocs, ictxt,&
        & msgindsent,msgactualsent,msgpercent,&
        & ph0_time, ph1_time, ph2_time, ph1_card, ph2_card,info,display_inp)
@@ -1431,6 +1131,6 @@ contains
     end if
     where(mate>=0) mate = mate + 1
 
-  end subroutine dPMatchBox
+  end subroutine amg_d_PMatchBox
 
-end module dmatchboxp_mod
+end module amg_d_matchboxp_mod

amgprec/amg_d_parmatch_aggregator_mod.F90

@@ -118,8 +118,11 @@
 
 module amg_d_parmatch_aggregator_mod
   use amg_d_base_aggregator_mod
-  use dmatchboxp_mod
-
+  use amg_d_matchboxp_mod
+#if defined(SERIAL_MPI)
+  type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
+  end type amg_d_parmatch_aggregator_type
+#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
@@ -129,8 +132,6 @@ module amg_d_parmatch_aggregator_mod
     type(psb_dspmat_type), allocatable  :: prol, restr
     type(psb_dspmat_type), allocatable  :: ac, base_a, rwa
     type(psb_desc_type), allocatable    :: desc_ac, desc_ax, base_desc, rwdesc
-    integer(psb_ipk_) :: max_csize
-    integer(psb_ipk_) :: max_nlevels
     logical           :: reproducible_matching = .false.
     logical           :: need_symmetrize       = .false.
     logical           :: unsmoothed_hierarchy  = .true.
@@ -140,18 +141,18 @@ module amg_d_parmatch_aggregator_mod
     procedure, pass(ag) :: mat_asb      => amg_d_parmatch_aggregator_mat_asb
     procedure, pass(ag) :: inner_mat_asb      => amg_d_parmatch_aggregator_inner_mat_asb
     procedure, pass(ag) :: bld_map      => amg_d_parmatch_aggregator_bld_map
-    procedure, pass(ag) :: csetc        => d_parmatch_aggr_csetc
-    procedure, pass(ag) :: cseti        => d_parmatch_aggr_cseti
-    procedure, pass(ag) :: default      => d_parmatch_aggr_set_default
-    procedure, pass(ag) :: sizeof       => d_parmatch_aggregator_sizeof
-    procedure, pass(ag) :: update_next  => d_parmatch_aggregator_update_next
-    procedure, pass(ag) :: bld_wnxt     => d_parmatch_bld_wnxt
-    procedure, pass(ag) :: bld_default_w    => d_bld_default_w
-    procedure, pass(ag) :: set_c_default_w  => d_set_prm_c_default_w
-    procedure, pass(ag) :: descr        => d_parmatch_aggregator_descr
-    procedure, pass(ag) :: clone        => d_parmatch_aggregator_clone
-    procedure, pass(ag) :: free         => d_parmatch_aggregator_free
-    procedure, nopass   :: fmt          => d_parmatch_aggregator_fmt
+    procedure, pass(ag) :: csetc        => amg_d_parmatch_aggr_csetc
+    procedure, pass(ag) :: cseti        => amg_d_parmatch_aggr_cseti
+    procedure, pass(ag) :: default      => amg_d_parmatch_aggr_set_default
+    procedure, pass(ag) :: sizeof       => amg_d_parmatch_aggregator_sizeof
+    procedure, pass(ag) :: update_next  => amg_d_parmatch_aggregator_update_next
+    procedure, pass(ag) :: bld_wnxt     => amg_d_parmatch_bld_wnxt
+    procedure, pass(ag) :: bld_default_w    => amg_d_bld_default_w
+    procedure, pass(ag) :: set_c_default_w  => amg_d_set_prm_c_default_w
+    procedure, pass(ag) :: descr        => amg_d_parmatch_aggregator_descr
+    procedure, pass(ag) :: clone        => amg_d_parmatch_aggregator_clone
+    procedure, pass(ag) :: free         => amg_d_parmatch_aggregator_free
+    procedure, nopass   :: fmt          => amg_d_parmatch_aggregator_fmt
     procedure, nopass   :: xt_desc      => amg_d_parmatch_aggregator_xt_desc
   end type amg_d_parmatch_aggregator_type
 
@@ -165,7 +166,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 +233,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 +255,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 +273,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 +286,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 +304,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
@@ -317,7 +318,7 @@ module amg_d_parmatch_aggregator_mod
 
 contains
 
-  subroutine d_bld_default_w(ag,nr)
+  subroutine amg_d_bld_default_w(ag,nr)
     use psb_realloc_mod
     implicit none
     class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -327,9 +328,9 @@ contains
     if (info /= psb_success_) return
     ag%w = done
     !call ag%set_c_default_w()
-  end subroutine d_bld_default_w
+  end subroutine amg_d_bld_default_w
 
-  subroutine d_set_prm_c_default_w(ag)
+  subroutine amg_d_set_prm_c_default_w(ag)
     use psb_realloc_mod
     use iso_c_binding
     implicit none
@@ -339,9 +340,9 @@ contains
     !write(0,*) 'prm_c_deafult_w '
     call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
 
-  end subroutine d_set_prm_c_default_w
+  end subroutine amg_d_set_prm_c_default_w
 
-  subroutine d_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
+  subroutine amg_d_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
     use psb_realloc_mod
     implicit none
     class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -355,14 +356,14 @@ contains
     !write(0,*) 'Executing bld_wnxt ',nx
     call psb_realloc(nx,ag%w_nxt,info)
 
-  end subroutine d_parmatch_bld_wnxt
+  end subroutine amg_d_parmatch_bld_wnxt
 
-  function d_parmatch_aggregator_fmt() result(val)
+  function amg_d_parmatch_aggregator_fmt() result(val)
     implicit none
     character(len=32)  :: val
 
     val = "Parallel Matching aggregation"
-  end function d_parmatch_aggregator_fmt
+  end function amg_d_parmatch_aggregator_fmt
 
   function amg_d_parmatch_aggregator_xt_desc() result(val)
     implicit none
@@ -371,7 +372,7 @@ contains
     val = .true.
   end function amg_d_parmatch_aggregator_xt_desc
 
-  function d_parmatch_aggregator_sizeof(ag) result(val)
+  function amg_d_parmatch_aggregator_sizeof(ag) result(val)
     use psb_realloc_mod
     implicit none
     class(amg_d_parmatch_aggregator_type), intent(in)  :: ag
@@ -387,9 +388,9 @@ contains
     if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
     if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
 
-  end function d_parmatch_aggregator_sizeof
+  end function amg_d_parmatch_aggregator_sizeof
 
-  subroutine  d_parmatch_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_d_parmatch_aggregator_descr(ag,parms,iout,info)
     implicit none
     class(amg_d_parmatch_aggregator_type), intent(in) :: ag
     type(amg_dml_parms), intent(in)   :: parms
@@ -403,7 +404,7 @@ contains
     call parms%mldescr(iout,info)
 
     return
-  end subroutine d_parmatch_aggregator_descr
+  end subroutine amg_d_parmatch_aggregator_descr
 
   function is_legal_malg(alg) result(val)
     logical :: val
@@ -434,7 +435,7 @@ contains
   end function is_legal_nlevels
 
 
-  subroutine  d_parmatch_aggregator_update_next(ag,agnext,info)
+  subroutine  amg_d_parmatch_aggregator_update_next(ag,agnext,info)
     use psb_realloc_mod
     implicit none
     class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -449,10 +450,10 @@ contains
            & agnext%matching_alg = ag%matching_alg
       if (.not.is_legal_nsweeps(agnext%n_sweeps))&
            & agnext%n_sweeps     = ag%n_sweeps
-      if (.not.is_legal_csize(agnext%max_csize))&
-           & agnext%max_csize    = ag%max_csize
-      if (.not.is_legal_nlevels(agnext%max_nlevels))&
-           & agnext%max_nlevels  = ag%max_nlevels
+!!$      if (.not.is_legal_csize(agnext%max_csize))&
+!!$           & agnext%max_csize    = ag%max_csize
+!!$      if (.not.is_legal_nlevels(agnext%max_nlevels))&
+!!$           & agnext%max_nlevels  = ag%max_nlevels
       ! Is this going to generate shallow copies/memory leaks/double frees?
       ! To be investigated further.
       call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
@@ -467,9 +468,9 @@ contains
       ! What should we do here?
     end select
     info = 0
-  end subroutine d_parmatch_aggregator_update_next
+  end subroutine amg_d_parmatch_aggregator_update_next
 
-  subroutine d_parmatch_aggr_csetc(ag,what,val,info,idx)
+  subroutine amg_d_parmatch_aggr_csetc(ag,what,val,info,idx)
 
     Implicit None
 
@@ -511,9 +512,9 @@ contains
       ! Do nothing
     end select
     return
-  end subroutine d_parmatch_aggr_csetc
+  end subroutine amg_d_parmatch_aggr_csetc
 
-  subroutine d_parmatch_aggr_cseti(ag,what,val,info,idx)
+  subroutine amg_d_parmatch_aggr_cseti(ag,what,val,info,idx)
 
     Implicit None
 
@@ -537,10 +538,6 @@ contains
     case('AGGR_SIZE')
       ag%orig_aggr_size = val
       ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
-    case('PRMC_MAX_CSIZE')
-      ag%max_csize=val
-    case('PRMC_MAX_NLEVELS')
-      ag%max_nlevels=val
     case('PRMC_W_SIZE')
       call ag%bld_default_w(val)
     case('PRMC_REPRODUCIBLE_MATCHING')
@@ -553,9 +550,9 @@ contains
       ! Do nothing
     end select
     return
-  end subroutine d_parmatch_aggr_cseti
+  end subroutine amg_d_parmatch_aggr_cseti
 
-  subroutine d_parmatch_aggr_set_default(ag)
+  subroutine amg_d_parmatch_aggr_set_default(ag)
 
     Implicit None
 
@@ -566,8 +563,8 @@ contains
     ag%matching_alg  = 0
     ag%n_sweeps      = 1
     ag%jacobi_sweeps = 0
-    ag%max_nlevels   = 36
-    ag%max_csize     = -1
+!!$    ag%max_nlevels   = 36
+!!$    ag%max_csize     = -1
     !
     ! Apparently BootCMatch works better
     ! by keeping all entries
@@ -576,9 +573,9 @@ contains
 
     return
 
-  end subroutine d_parmatch_aggr_set_default
+  end subroutine amg_d_parmatch_aggr_set_default
 
-  subroutine  d_parmatch_aggregator_free(ag,info)
+  subroutine  amg_d_parmatch_aggregator_free(ag,info)
     use iso_c_binding
     implicit none
     class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
@@ -615,9 +612,9 @@ contains
       call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
     end if
 
-  end subroutine d_parmatch_aggregator_free
+  end subroutine amg_d_parmatch_aggregator_free
 
-  subroutine  d_parmatch_aggregator_clone(ag,agnext,info)
+  subroutine  amg_d_parmatch_aggregator_clone(ag,agnext,info)
     implicit none
     class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
     class(amg_d_base_aggregator_type), allocatable, intent(inout) :: agnext
@@ -637,7 +634,7 @@ contains
       ! Should never ever get here
       info = -1
     end select
-  end subroutine d_parmatch_aggregator_clone
+  end subroutine amg_d_parmatch_aggregator_clone
 
   subroutine  amg_d_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
        & op_restr,op_prol,map,info)
@@ -681,5 +678,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_d_sludist_solver.F90

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

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

@@ -68,7 +68,7 @@
 !    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 !    POSSIBILITY OF SUCH DAMAGE.
 !
-module smatchboxp_mod
+module amg_s_matchboxp_mod
 
   use iso_c_binding
   use psb_base_cbind_mod
@@ -94,33 +94,25 @@ module smatchboxp_mod
     end subroutine sMatchBoxPC
   end interface MatchBoxPC
 
-  interface i_aggr_assign
-    module procedure i_saggr_assign
-  end interface i_aggr_assign
+  interface amg_i_aggr_assign
+    module procedure amg_i_s_aggr_assign
+  end interface amg_i_aggr_assign
 
-  interface build_matching
-    module procedure sbuild_matching
-  end interface build_matching
+  interface amg_par_build_matching
+    module procedure amg_s_par_build_matching
+  end interface amg_par_build_matching
 
-  interface build_ahat
-    module procedure sbuild_ahat
-  end interface build_ahat
+  interface amg_par_build_ahat
+    module procedure amg_s_par_build_ahat
+  end interface amg_par_build_ahat
 
-  interface psb_gtranspose
-    module procedure psb_sgtranspose
-  end interface psb_gtranspose
-
-  interface psb_htranspose
-    module procedure psb_shtranspose
-  end interface psb_htranspose
-
-  interface PMatchBox
-    module procedure sPMatchBox
-  end interface PMatchBox
+  interface amg_PMatchBox
+    module procedure amg_s_PMatchBox
+  end interface amg_PMatchBox
 
 contains
 
-  subroutine smatchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
+  subroutine amg_s_matchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
        & symmetrize,reproducible,display_inp, display_out, print_out)
     use psb_base_mod
     use psb_util_mod
@@ -213,7 +205,7 @@ contains
     end if
     if (do_timings) call psb_toc(idx_phase1)
     if (do_timings) call psb_tic(idx_bldmtc)
-    call build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
+    call amg_par_build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
     if (do_timings) call psb_toc(idx_bldmtc)
     if (debug) write(0,*) iam,' buildprol from buildmatching:',&
          & info
@@ -311,7 +303,7 @@ contains
                   ! Should be a symmetric function.
                   !
                   call desc_a%indxmap%qry_halo_owner(idx,iown,info)
-                  ip    = i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
+                  ip    = amg_i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
                   if (iam == ip) then
                     nlaggr(iam) = nlaggr(iam) + 1
                     ilaggr(k)   = nlaggr(iam)
@@ -513,9 +505,9 @@ contains
       write(0,*) iam,' :  error from Matching: ',info
     end if
 
-  end subroutine smatchboxp_build_prol
+  end subroutine amg_s_matchboxp_build_prol
 
-  function i_saggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
+  function amg_i_s_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
        & result(iproc)
     !
     ! How to break ties? This
@@ -557,10 +549,10 @@ contains
         iproc = iown
       end if
     end if
-  end function i_saggr_assign
+  end function amg_i_s_aggr_assign
 
 
-  subroutine sbuild_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
+  subroutine amg_s_par_build_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
     use psb_base_mod
     use psb_util_mod
     use iso_c_binding
@@ -609,7 +601,7 @@ contains
       if (iam == 0) write(0,*)' Into build_ahat:'
     end if
     if (do_timings) call psb_tic(idx_bldahat)
-    call build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
+    call amg_par_build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
     if (do_timings) call psb_toc(idx_bldahat)
     if (info /= 0) then
       write(0,*) 'Error from build_ahat ', info
@@ -700,7 +692,7 @@ contains
       !
       if (debug) write(0,*) iam,' buildmatching into PMatchBox:'
       if (do_timings) call psb_tic(idx_cmboxp)
-      call PMatchBox(nr,nz,vlptr,vlind,ewght,&
+      call amg_PMatchBox(nr,nz,vlptr,vlind,ewght,&
            & vnl, mate, iam, np,ictxt,&
            & msgis,msgas,msgprc,ph0t,ph1t,ph2t,ph1crd,ph2crd,info,display_inp)
       if (do_timings) call psb_toc(idx_cmboxp)
@@ -764,9 +756,9 @@ contains
       val(1:n) = tmp(1:n)
     end subroutine fix_order
 
-  end subroutine sbuild_matching
+  end subroutine amg_s_par_build_matching
 
-  subroutine sbuild_ahat(w,a,ahat,desc_a,info,symmetrize)
+  subroutine amg_s_par_build_ahat(w,a,ahat,desc_a,info,symmetrize)
     use psb_base_mod
     implicit none
     real(psb_spk_), intent(in)           :: w(:)
@@ -1002,301 +994,9 @@ contains
       end block
     end if
 
-  end subroutine sbuild_ahat
+  end subroutine amg_s_par_build_ahat
 
-  subroutine psb_sgtranspose(ain,aout,desc_a,info)
-    use psb_base_mod
-    implicit none
-    type(psb_lsspmat_type), intent(in)  :: ain
-    type(psb_lsspmat_type), intent(out) :: aout
-    type(psb_desc_type)           :: desc_a
-    integer(psb_ipk_), intent(out) :: info
-
-    !
-    ! BEWARE: This routine works under the assumption
-    ! that the same DESC_A works for both A and A^T, which
-    ! essentially means that A has a symmetric pattern.
-    !
-    type(psb_lsspmat_type) :: atmp, ahalo, aglb
-    type(psb_ls_coo_sparse_mat) :: tmpcoo
-    type(psb_ls_csr_sparse_mat) :: tmpcsr
-    type(psb_ctxt_type) :: ictxt
-    integer(psb_ipk_) :: me, np
-    integer(psb_lpk_) :: i, j, k, nrow, ncol
-    integer(psb_lpk_), allocatable :: ilv(:)
-    character(len=80) :: aname
-    logical, parameter :: debug=.false., dump=.false., debug_sync=.false.
-
-    ictxt = desc_a%get_context()
-    call psb_info(ictxt,me,np)
-
-    nrow = desc_a%get_local_rows()
-    ncol = desc_a%get_local_cols()
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'Start gtranspose '
-    end if
-    call ain%cscnv(tmpcsr,info)
-
-    if (debug) then
-      ilv = [(i,i=1,ncol)]
-      call desc_a%l2gip(ilv,info,owned=.false.)
-      write(aname,'(a,i3.3,a)') 'atmp-preh-',me,'.mtx'
-      call ain%print(fname=aname,head='atmp before haloTest ',iv=ilv)
-    end if
-    if (dump) then
-      call ain%cscnv(atmp,info)
-      call psb_gather(aglb,atmp,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'aglob-prehalo.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-    !call psb_loc_to_glob(tmpcsr%ja,desc_a,info)
-    call atmp%mv_from(tmpcsr)
-
-    if (debug) then
-      write(aname,'(a,i3.3,a)') 'tmpcsr-',me,'.mtx'
-      call atmp%print(fname=aname,head='tmpcsr ',iv=ilv)
-      !call psb_set_debug_level(9999)
-    end if
-
-    ! FIXME THIS NEEDS REWORKING
-    if (debug) write(0,*) me,' Gtranspose into sphalo :',atmp%get_nrows(),atmp%get_ncols()
-    call psb_sphalo(atmp,desc_a,ahalo,info,rowscale=.true.)
-    if (debug) write(0,*) me,' Gtranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols()
-    if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
-
-    if (debug) then
-      write(aname,'(a,i3.3,a)') 'ahalo-',me,'.mtx'
-      call ahalo%print(fname=aname,head='ahalo after haloTest ',iv=ilv)
-      write(aname,'(a,i3.3,a)') 'atmp-h-',me,'.mtx'
-      call atmp%print(fname=aname,head='atmp after haloTest ',iv=ilv)
-    end if
-
-    if (info == psb_success_) call ahalo%free()
-
-    call atmp%cp_to(tmpcoo)
-    call tmpcoo%transp()
-    !call psb_glob_to_loc(tmpcoo%ia,desc_a,info,iact='I')
-    if (debug) write(0,*) 'Before cleanup:',tmpcoo%get_nzeros()
-
-    j = 0
-    do k=1, tmpcoo%get_nzeros()
-      if ((tmpcoo%ia(k) > 0).and.(tmpcoo%ja(k)>0)) then
-        j = j+1
-        tmpcoo%ia(j)  = tmpcoo%ia(k)
-        tmpcoo%ja(j)  = tmpcoo%ja(k)
-        tmpcoo%val(j) = tmpcoo%val(k)
-      end if
-    end do
-    call tmpcoo%set_nzeros(j)
-
-    if (debug) write(0,*) 'After cleanup:',tmpcoo%get_nzeros()
-
-    call ahalo%mv_from(tmpcoo)
-    if (dump) then
-      call psb_gather(aglb,ahalo,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'atran-preclip.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-
-    call ahalo%csclip(aout,info,imax=nrow)
-
-    if (debug) write(0,*) 'After clip:',aout%get_nzeros()
-
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'End gtranspose '
-    end if
-    !call aout%cscnv(info,type='csr')
-
-    if (dump) then
-      write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx'
-      call aout%print(fname=aname,head='atrans ',iv=ilv)
-      call psb_gather(aglb,aout,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'atran.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-  end subroutine psb_sgtranspose
-
-  subroutine psb_shtranspose(ain,aout,desc_a,info)
-    use psb_base_mod
-    implicit none
-    type(psb_lsspmat_type), intent(in)  :: ain
-    type(psb_lsspmat_type), intent(out) :: aout
-    type(psb_desc_type)           :: desc_a
-    integer(psb_ipk_), intent(out) :: info
-
-    !
-    ! BEWARE: This routine works under the assumption
-    ! that the same DESC_A works for both A and A^T, which
-    ! essentially means that A has a symmetric pattern.
-    !
-    type(psb_lsspmat_type) :: atmp, ahalo, aglb
-    type(psb_ls_coo_sparse_mat) :: tmpcoo, tmpc1, tmpc2, tmpch
-    type(psb_ls_csr_sparse_mat) :: tmpcsr
-    integer(psb_ipk_) :: nz1, nz2, nzh, nz
-    type(psb_ctxt_type) :: ictxt
-    integer(psb_ipk_) :: me, np
-    integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz
-    integer(psb_lpk_), allocatable :: ilv(:)
-    character(len=80) :: aname
-    logical, parameter :: debug=.false., dump=.false., debug_sync=.false.
-
-    ictxt = desc_a%get_context()
-    call psb_info(ictxt,me,np)
-
-    nrow = desc_a%get_local_rows()
-    ncol = desc_a%get_local_cols()
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'Start htranspose '
-    end if
-    call ain%cscnv(tmpcsr,info)
-
-    if (debug) then
-      ilv = [(i,i=1,ncol)]
-      call desc_a%l2gip(ilv,info,owned=.false.)
-      write(aname,'(a,i3.3,a)') 'atmp-preh-',me,'.mtx'
-      call ain%print(fname=aname,head='atmp before haloTest ',iv=ilv)
-    end if
-    if (dump) then
-      call ain%cscnv(atmp,info)
-      call psb_gather(aglb,atmp,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'aglob-prehalo.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-    !call psb_loc_to_glob(tmpcsr%ja,desc_a,info)
-    call atmp%mv_from(tmpcsr)
-
-    if (debug) then
-      write(aname,'(a,i3.3,a)') 'tmpcsr-',me,'.mtx'
-      call atmp%print(fname=aname,head='tmpcsr ',iv=ilv)
-      !call psb_set_debug_level(9999)
-    end if
-
-    ! FIXME THIS NEEDS REWORKING
-    if (debug) write(0,*) me,' Htranspose into sphalo :',atmp%get_nrows(),atmp%get_ncols()
-    if (.true.) then
-      call psb_sphalo(atmp,desc_a,ahalo,info, outfmt='coo  ')
-      call atmp%mv_to(tmpc1)
-      call ahalo%mv_to(tmpch)
-      nz1 = tmpc1%get_nzeros()
-      call psb_loc_to_glob(tmpc1%ia(1:nz1),desc_a,info,iact='I')
-      call psb_loc_to_glob(tmpc1%ja(1:nz1),desc_a,info,iact='I')
-      nzh = tmpch%get_nzeros()
-      call psb_loc_to_glob(tmpch%ia(1:nzh),desc_a,info,iact='I')
-      call psb_loc_to_glob(tmpch%ja(1:nzh),desc_a,info,iact='I')
-      nlz = nz1+nzh
-      call tmpcoo%allocate(ncol,ncol,nlz)
-      tmpcoo%ia(1:nz1) = tmpc1%ia(1:nz1)
-      tmpcoo%ja(1:nz1) = tmpc1%ja(1:nz1)
-      tmpcoo%val(1:nz1) = tmpc1%val(1:nz1)
-      tmpcoo%ia(nz1+1:nz1+nzh) = tmpch%ia(1:nzh)
-      tmpcoo%ja(nz1+1:nz1+nzh) = tmpch%ja(1:nzh)
-      tmpcoo%val(nz1+1:nz1+nzh) = tmpch%val(1:nzh)
-      call tmpcoo%set_nzeros(nlz)
-      call tmpcoo%transp()
-      nz = tmpcoo%get_nzeros()
-      call psb_glob_to_loc(tmpcoo%ia(1:nz),desc_a,info,iact='I')
-      call psb_glob_to_loc(tmpcoo%ja(1:nz),desc_a,info,iact='I')
-      if (.true.) then
-        call tmpcoo%clean_negidx(info)
-      else
-        j = 0
-        do k=1, tmpcoo%get_nzeros()
-          if ((tmpcoo%ia(k) > 0).and.(tmpcoo%ja(k)>0)) then
-            j = j+1
-            tmpcoo%ia(j)  = tmpcoo%ia(k)
-            tmpcoo%ja(j)  = tmpcoo%ja(k)
-            tmpcoo%val(j) = tmpcoo%val(k)
-          end if
-        end do
-        call tmpcoo%set_nzeros(j)
-      end if
-      call ahalo%mv_from(tmpcoo)
-      call ahalo%csclip(aout,info,imax=nrow)
-
-    else
-      call psb_sphalo(atmp,desc_a,ahalo,info, rowscale=.true.)
-      if (debug) write(0,*) me,' Htranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols()
-      if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
-
-      if (debug) then
-        write(aname,'(a,i3.3,a)') 'ahalo-',me,'.mtx'
-        call ahalo%print(fname=aname,head='ahalo after haloTest ',iv=ilv)
-        write(aname,'(a,i3.3,a)') 'atmp-h-',me,'.mtx'
-        call atmp%print(fname=aname,head='atmp after haloTest ',iv=ilv)
-      end if
-
-      if (info == psb_success_) call ahalo%free()
-
-      call atmp%cp_to(tmpcoo)
-      call tmpcoo%transp()
-      if (debug) write(0,*) 'Before cleanup:',tmpcoo%get_nzeros()
-      if (.true.) then
-        call tmpcoo%clean_negidx(info)
-      else
-
-        j = 0
-        do k=1, tmpcoo%get_nzeros()
-          if ((tmpcoo%ia(k) > 0).and.(tmpcoo%ja(k)>0)) then
-            j = j+1
-            tmpcoo%ia(j)  = tmpcoo%ia(k)
-            tmpcoo%ja(j)  = tmpcoo%ja(k)
-            tmpcoo%val(j) = tmpcoo%val(k)
-          end if
-        end do
-        call tmpcoo%set_nzeros(j)
-      end if
-
-      if (debug) write(0,*) 'After cleanup:',tmpcoo%get_nzeros()
-
-      call ahalo%mv_from(tmpcoo)
-      if (dump) then
-        call psb_gather(aglb,ahalo,desc_a,info)
-        if (me==psb_root_) then
-          write(aname,'(a,i3.3,a)') 'atran-preclip.mtx'
-          call aglb%print(fname=aname,head='Test ')
-        end if
-      end if
-
-
-      call ahalo%csclip(aout,info,imax=nrow)
-    end if
-
-    if (debug) write(0,*) 'After clip:',aout%get_nzeros()
-
-    if (debug_sync) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'End htranspose '
-    end if
-    !call aout%cscnv(info,type='csr')
-
-    if (dump) then
-      write(aname,'(a,i3.3,a)') 'atran-',me,'.mtx'
-      call aout%print(fname=aname,head='atrans ',iv=ilv)
-      call psb_gather(aglb,aout,desc_a,info)
-      if (me==psb_root_) then
-        write(aname,'(a,i3.3,a)') 'atran.mtx'
-        call aglb%print(fname=aname,head='Test ')
-      end if
-    end if
-
-  end subroutine psb_shtranspose
-
-  subroutine sPMatchBox(nlver,nledge,verlocptr,verlocind,edgelocweight,&
+  subroutine amg_s_PMatchBox(nlver,nledge,verlocptr,verlocind,edgelocweight,&
        & verdistance, mate, myrank, numprocs, ictxt,&
        & msgindsent,msgactualsent,msgpercent,&
        & ph0_time, ph1_time, ph2_time, ph1_card, ph2_card,info,display_inp)
@@ -1431,6 +1131,6 @@ contains
     end if
     where(mate>=0) mate = mate + 1
 
-  end subroutine sPMatchBox
+  end subroutine amg_s_PMatchBox
 
-end module smatchboxp_mod
+end module amg_s_matchboxp_mod

amgprec/amg_s_parmatch_aggregator_mod.F90

@@ -118,8 +118,11 @@
 
 module amg_s_parmatch_aggregator_mod
   use amg_s_base_aggregator_mod
-  use smatchboxp_mod
-
+  use amg_s_matchboxp_mod
+#if defined(SERIAL_MPI)
+  type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
+  end type amg_s_parmatch_aggregator_type
+#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
@@ -129,8 +132,6 @@ module amg_s_parmatch_aggregator_mod
     type(psb_sspmat_type), allocatable  :: prol, restr
     type(psb_sspmat_type), allocatable  :: ac, base_a, rwa
     type(psb_desc_type), allocatable    :: desc_ac, desc_ax, base_desc, rwdesc
-    integer(psb_ipk_) :: max_csize
-    integer(psb_ipk_) :: max_nlevels
     logical           :: reproducible_matching = .false.
     logical           :: need_symmetrize       = .false.
     logical           :: unsmoothed_hierarchy  = .true.
@@ -140,18 +141,18 @@ module amg_s_parmatch_aggregator_mod
     procedure, pass(ag) :: mat_asb      => amg_s_parmatch_aggregator_mat_asb
     procedure, pass(ag) :: inner_mat_asb      => amg_s_parmatch_aggregator_inner_mat_asb
     procedure, pass(ag) :: bld_map      => amg_s_parmatch_aggregator_bld_map
-    procedure, pass(ag) :: csetc        => s_parmatch_aggr_csetc
-    procedure, pass(ag) :: cseti        => s_parmatch_aggr_cseti
-    procedure, pass(ag) :: default      => s_parmatch_aggr_set_default
-    procedure, pass(ag) :: sizeof       => s_parmatch_aggregator_sizeof
-    procedure, pass(ag) :: update_next  => s_parmatch_aggregator_update_next
-    procedure, pass(ag) :: bld_wnxt     => s_parmatch_bld_wnxt
-    procedure, pass(ag) :: bld_default_w    => s_bld_default_w
-    procedure, pass(ag) :: set_c_default_w  => s_set_prm_c_default_w
-    procedure, pass(ag) :: descr        => s_parmatch_aggregator_descr
-    procedure, pass(ag) :: clone        => s_parmatch_aggregator_clone
-    procedure, pass(ag) :: free         => s_parmatch_aggregator_free
-    procedure, nopass   :: fmt          => s_parmatch_aggregator_fmt
+    procedure, pass(ag) :: csetc        => amg_s_parmatch_aggr_csetc
+    procedure, pass(ag) :: cseti        => amg_s_parmatch_aggr_cseti
+    procedure, pass(ag) :: default      => amg_s_parmatch_aggr_set_default
+    procedure, pass(ag) :: sizeof       => amg_s_parmatch_aggregator_sizeof
+    procedure, pass(ag) :: update_next  => amg_s_parmatch_aggregator_update_next
+    procedure, pass(ag) :: bld_wnxt     => amg_s_parmatch_bld_wnxt
+    procedure, pass(ag) :: bld_default_w    => amg_s_bld_default_w
+    procedure, pass(ag) :: set_c_default_w  => amg_s_set_prm_c_default_w
+    procedure, pass(ag) :: descr        => amg_s_parmatch_aggregator_descr
+    procedure, pass(ag) :: clone        => amg_s_parmatch_aggregator_clone
+    procedure, pass(ag) :: free         => amg_s_parmatch_aggregator_free
+    procedure, nopass   :: fmt          => amg_s_parmatch_aggregator_fmt
     procedure, nopass   :: xt_desc      => amg_s_parmatch_aggregator_xt_desc
   end type amg_s_parmatch_aggregator_type
 
@@ -165,7 +166,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 +233,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 +255,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 +273,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 +286,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 +304,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
@@ -317,7 +318,7 @@ module amg_s_parmatch_aggregator_mod
 
 contains
 
-  subroutine s_bld_default_w(ag,nr)
+  subroutine amg_s_bld_default_w(ag,nr)
     use psb_realloc_mod
     implicit none
     class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -327,9 +328,9 @@ contains
     if (info /= psb_success_) return
     ag%w = done
     !call ag%set_c_default_w()
-  end subroutine s_bld_default_w
+  end subroutine amg_s_bld_default_w
 
-  subroutine s_set_prm_c_default_w(ag)
+  subroutine amg_s_set_prm_c_default_w(ag)
     use psb_realloc_mod
     use iso_c_binding
     implicit none
@@ -339,9 +340,9 @@ contains
     !write(0,*) 'prm_c_deafult_w '
     call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
 
-  end subroutine s_set_prm_c_default_w
+  end subroutine amg_s_set_prm_c_default_w
 
-  subroutine s_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
+  subroutine amg_s_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
     use psb_realloc_mod
     implicit none
     class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -355,14 +356,14 @@ contains
     !write(0,*) 'Executing bld_wnxt ',nx
     call psb_realloc(nx,ag%w_nxt,info)
 
-  end subroutine s_parmatch_bld_wnxt
+  end subroutine amg_s_parmatch_bld_wnxt
 
-  function s_parmatch_aggregator_fmt() result(val)
+  function amg_s_parmatch_aggregator_fmt() result(val)
     implicit none
     character(len=32)  :: val
 
     val = "Parallel Matching aggregation"
-  end function s_parmatch_aggregator_fmt
+  end function amg_s_parmatch_aggregator_fmt
 
   function amg_s_parmatch_aggregator_xt_desc() result(val)
     implicit none
@@ -371,7 +372,7 @@ contains
     val = .true.
   end function amg_s_parmatch_aggregator_xt_desc
 
-  function s_parmatch_aggregator_sizeof(ag) result(val)
+  function amg_s_parmatch_aggregator_sizeof(ag) result(val)
     use psb_realloc_mod
     implicit none
     class(amg_s_parmatch_aggregator_type), intent(in)  :: ag
@@ -387,9 +388,9 @@ contains
     if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
     if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
 
-  end function s_parmatch_aggregator_sizeof
+  end function amg_s_parmatch_aggregator_sizeof
 
-  subroutine  s_parmatch_aggregator_descr(ag,parms,iout,info)
+  subroutine  amg_s_parmatch_aggregator_descr(ag,parms,iout,info)
     implicit none
     class(amg_s_parmatch_aggregator_type), intent(in) :: ag
     type(amg_sml_parms), intent(in)   :: parms
@@ -403,7 +404,7 @@ contains
     call parms%mldescr(iout,info)
 
     return
-  end subroutine s_parmatch_aggregator_descr
+  end subroutine amg_s_parmatch_aggregator_descr
 
   function is_legal_malg(alg) result(val)
     logical :: val
@@ -434,7 +435,7 @@ contains
   end function is_legal_nlevels
 
 
-  subroutine  s_parmatch_aggregator_update_next(ag,agnext,info)
+  subroutine  amg_s_parmatch_aggregator_update_next(ag,agnext,info)
     use psb_realloc_mod
     implicit none
     class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
@@ -449,10 +450,10 @@ contains
            & agnext%matching_alg = ag%matching_alg
       if (.not.is_legal_nsweeps(agnext%n_sweeps))&
            & agnext%n_sweeps     = ag%n_sweeps
-      if (.not.is_legal_csize(agnext%max_csize))&
-           & agnext%max_csize    = ag%max_csize
-      if (.not.is_legal_nlevels(agnext%max_nlevels))&
-           & agnext%max_nlevels  = ag%max_nlevels
+!!$      if (.not.is_legal_csize(agnext%max_csize))&
+!!$           & agnext%max_csize    = ag%max_csize
+!!$      if (.not.is_legal_nlevels(agnext%max_nlevels))&
+!!$           & agnext%max_nlevels  = ag%max_nlevels
       ! Is this going to generate shallow copies/memory leaks/double frees?
       ! To be investigated further.
       call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
@@ -467,9 +468,9 @@ contains
       ! What should we do here?
     end select
     info = 0
-  end subroutine s_parmatch_aggregator_update_next
+  end subroutine amg_s_parmatch_aggregator_update_next
 
-  subroutine s_parmatch_aggr_csetc(ag,what,val,info,idx)
+  subroutine amg_s_parmatch_aggr_csetc(ag,what,val,info,idx)
 
     Implicit None
 
@@ -511,9 +512,9 @@ contains
       ! Do nothing
     end select
     return
-  end subroutine s_parmatch_aggr_csetc
+  end subroutine amg_s_parmatch_aggr_csetc
 
-  subroutine s_parmatch_aggr_cseti(ag,what,val,info,idx)
+  subroutine amg_s_parmatch_aggr_cseti(ag,what,val,info,idx)
 
     Implicit None
 
@@ -537,10 +538,6 @@ contains
     case('AGGR_SIZE')
       ag%orig_aggr_size = val
       ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
-    case('PRMC_MAX_CSIZE')
-      ag%max_csize=val
-    case('PRMC_MAX_NLEVELS')
-      ag%max_nlevels=val
     case('PRMC_W_SIZE')
       call ag%bld_default_w(val)
     case('PRMC_REPRODUCIBLE_MATCHING')
@@ -553,9 +550,9 @@ contains
       ! Do nothing
     end select
     return
-  end subroutine s_parmatch_aggr_cseti
+  end subroutine amg_s_parmatch_aggr_cseti
 
-  subroutine s_parmatch_aggr_set_default(ag)
+  subroutine amg_s_parmatch_aggr_set_default(ag)
 
     Implicit None
 
@@ -566,8 +563,8 @@ contains
     ag%matching_alg  = 0
     ag%n_sweeps      = 1
     ag%jacobi_sweeps = 0
-    ag%max_nlevels   = 36
-    ag%max_csize     = -1
+!!$    ag%max_nlevels   = 36
+!!$    ag%max_csize     = -1
     !
     ! Apparently BootCMatch works better
     ! by keeping all entries
@@ -576,9 +573,9 @@ contains
 
     return
 
-  end subroutine s_parmatch_aggr_set_default
+  end subroutine amg_s_parmatch_aggr_set_default
 
-  subroutine  s_parmatch_aggregator_free(ag,info)
+  subroutine  amg_s_parmatch_aggregator_free(ag,info)
     use iso_c_binding
     implicit none
     class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
@@ -615,9 +612,9 @@ contains
       call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
     end if
 
-  end subroutine s_parmatch_aggregator_free
+  end subroutine amg_s_parmatch_aggregator_free
 
-  subroutine  s_parmatch_aggregator_clone(ag,agnext,info)
+  subroutine  amg_s_parmatch_aggregator_clone(ag,agnext,info)
     implicit none
     class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
     class(amg_s_base_aggregator_type), allocatable, intent(inout) :: agnext
@@ -637,7 +634,7 @@ contains
       ! Should never ever get here
       info = -1
     end select
-  end subroutine s_parmatch_aggregator_clone
+  end subroutine amg_s_parmatch_aggregator_clone
 
   subroutine  amg_s_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
        & op_restr,op_prol,map,info)
@@ -681,5 +678,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/amg_z_sludist_solver.F90

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

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
@@ -131,7 +68,8 @@ subroutine  amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
   real(psb_dpk_), allocatable    :: tmpw(:), tmpwnxt(:)
   integer(psb_lpk_), allocatable :: ixaggr(:), nxaggr(:), tlaggr(:), ivr(:)
   type(psb_dspmat_type)          :: a_tmp
-  integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels
+  integer(psb_ipk_)    :: match_algorithm, n_sweeps
+  integer(psb_lpk_)    :: target_csize
   character(len=40)    :: name, ch_err
   character(len=80)    :: fname, prefix_
   type(psb_ctxt_type)  :: ictxt
@@ -181,6 +119,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
@@ -188,27 +129,22 @@ subroutine  amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
       write(debug_unit, *) 'Warning: AGGR_SIZE reset to value ',2**n_sweeps
     end if
   end if
-  if (ag%max_csize > 0) then
-    max_csize       = ag%max_csize
+  if (ag_data%target_coarse_size > 0) then
+    target_csize       = ag_data%target_coarse_size
   else
-    max_csize       = ag_data%min_coarse_size
-  end if
-  if (ag%max_nlevels > 0) then
-    max_nlevels     = ag%max_nlevels
-  else
-    max_nlevels = ag_data%max_levs
+    target_csize       = ag_data%min_coarse_size
   end if
   if (.true.) then
     block
       integer(psb_ipk_) :: ipv(2)
-      ipv(1) = max_csize
+      ipv(1) = target_csize
       ipv(2) = n_sweeps
       call psb_bcast(ictxt,ipv)
-      max_csize = ipv(1)
+      target_csize = ipv(1)
       n_sweeps  = ipv(2)
     end block
   else
-    call psb_bcast(ictxt,max_csize)
+    call psb_bcast(ictxt,target_csize)
     call psb_bcast(ictxt,n_sweeps)
   end if
   if (n_sweeps /= ag%n_sweeps) then
@@ -216,7 +152,7 @@ subroutine  amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
   end if
 !!$  if (me==0) write(0,*) 'Matching sweeps: ',n_sweeps
   n_sweeps = max(1,n_sweeps)
-  if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,max_csize
+  if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,target_csize
   if (ag%unsmoothed_hierarchy.and.allocated(ag%base_a)) then
     call ag%base_a%cp_to(acsr)
     if (ag%do_clean_zeros) call acsr%clean_zeros(info)
@@ -302,7 +238,7 @@ subroutine  amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
 
   if (debug) then
     call psb_barrier(ictxt)
-    if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),max_csize
+    if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),target_csize
   end if
 
   !
@@ -324,7 +260,7 @@ subroutine  amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
     !
     if (debug) write(0,*) me,' Into matchbox_build_prol ',info
     if (do_timings) call psb_tic(idx_mboxp)
-    call dmatchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,&
+    call amg_d_matchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,&
          & symmetrize=ag%need_symmetrize,reproducible=ag%reproducible_matching)
     if (do_timings) call psb_toc(idx_mboxp)
     if (debug) write(0,*) me,' Out from matchbox_build_prol ',info
@@ -360,11 +296,11 @@ subroutine  amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
 
     if (debug) then
       call psb_barrier(ictxt)
-      if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),max_csize,info
+      if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),target_csize,info
       csz = sum(nxaggr)
       call psb_bcast(ictxt,csz)
       if (csz /= sum(nxaggr)) write(0,*) me,trim(name),' Mismatch matasb',&
-           & csz,sum(nxaggr),max_csize
+           & csz,sum(nxaggr),target_csize
     end if
     if (psb_errstatus_fatal())  write(0,*)me,trim(name),'Error fatal on entry to tmpwnxt 2'
 
@@ -402,10 +338,10 @@ subroutine  amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
     call move_alloc(tmpwnxt,tmpw)
     if (debug) then
       if (csz /= sum(nlaggr)) write(0,*) me,trim(name),' Mismatch 2 matasb',&
-           & csz,sum(nlaggr),max_csize, info
+           & csz,sum(nlaggr),target_csize, info
     end if
     call acv(i-1)%free()
-    if ((sum(nlaggr) <= max_csize).or.(any(nlaggr==0))) then
+    if ((sum(nlaggr) <= target_csize).or.(any(nlaggr==0))) then
       x_sweeps = i
       exit sweeps_loop
     end if
@@ -530,17 +466,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
@@ -131,7 +68,8 @@ subroutine  amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
   real(psb_spk_), allocatable    :: tmpw(:), tmpwnxt(:)
   integer(psb_lpk_), allocatable :: ixaggr(:), nxaggr(:), tlaggr(:), ivr(:)
   type(psb_sspmat_type)          :: a_tmp
-  integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels
+  integer(psb_ipk_)    :: match_algorithm, n_sweeps
+  integer(psb_lpk_)    :: target_csize
   character(len=40)    :: name, ch_err
   character(len=80)    :: fname, prefix_
   type(psb_ctxt_type)  :: ictxt
@@ -181,6 +119,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
@@ -188,27 +129,22 @@ subroutine  amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
       write(debug_unit, *) 'Warning: AGGR_SIZE reset to value ',2**n_sweeps
     end if
   end if
-  if (ag%max_csize > 0) then
-    max_csize       = ag%max_csize
+  if (ag_data%target_coarse_size > 0) then
+    target_csize       = ag_data%target_coarse_size
   else
-    max_csize       = ag_data%min_coarse_size
-  end if
-  if (ag%max_nlevels > 0) then
-    max_nlevels     = ag%max_nlevels
-  else
-    max_nlevels = ag_data%max_levs
+    target_csize       = ag_data%min_coarse_size
   end if
   if (.true.) then
     block
       integer(psb_ipk_) :: ipv(2)
-      ipv(1) = max_csize
+      ipv(1) = target_csize
       ipv(2) = n_sweeps
       call psb_bcast(ictxt,ipv)
-      max_csize = ipv(1)
+      target_csize = ipv(1)
       n_sweeps  = ipv(2)
     end block
   else
-    call psb_bcast(ictxt,max_csize)
+    call psb_bcast(ictxt,target_csize)
     call psb_bcast(ictxt,n_sweeps)
   end if
   if (n_sweeps /= ag%n_sweeps) then
@@ -216,7 +152,7 @@ subroutine  amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
   end if
 !!$  if (me==0) write(0,*) 'Matching sweeps: ',n_sweeps
   n_sweeps = max(1,n_sweeps)
-  if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,max_csize
+  if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,target_csize
   if (ag%unsmoothed_hierarchy.and.allocated(ag%base_a)) then
     call ag%base_a%cp_to(acsr)
     if (ag%do_clean_zeros) call acsr%clean_zeros(info)
@@ -302,7 +238,7 @@ subroutine  amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
 
   if (debug) then
     call psb_barrier(ictxt)
-    if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),max_csize
+    if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),target_csize
   end if
 
   !
@@ -324,7 +260,7 @@ subroutine  amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
     !
     if (debug) write(0,*) me,' Into matchbox_build_prol ',info
     if (do_timings) call psb_tic(idx_mboxp)
-    call smatchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,&
+    call amg_s_matchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,&
          & symmetrize=ag%need_symmetrize,reproducible=ag%reproducible_matching)
     if (do_timings) call psb_toc(idx_mboxp)
     if (debug) write(0,*) me,' Out from matchbox_build_prol ',info
@@ -360,11 +296,11 @@ subroutine  amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
 
     if (debug) then
       call psb_barrier(ictxt)
-      if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),max_csize,info
+      if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),target_csize,info
       csz = sum(nxaggr)
       call psb_bcast(ictxt,csz)
       if (csz /= sum(nxaggr)) write(0,*) me,trim(name),' Mismatch matasb',&
-           & csz,sum(nxaggr),max_csize
+           & csz,sum(nxaggr),target_csize
     end if
     if (psb_errstatus_fatal())  write(0,*)me,trim(name),'Error fatal on entry to tmpwnxt 2'
 
@@ -402,10 +338,10 @@ subroutine  amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
     call move_alloc(tmpwnxt,tmpw)
     if (debug) then
       if (csz /= sum(nlaggr)) write(0,*) me,trim(name),' Mismatch 2 matasb',&
-           & csz,sum(nlaggr),max_csize, info
+           & csz,sum(nlaggr),target_csize, info
     end if
     call acv(i-1)%free()
-    if ((sum(nlaggr) <= max_csize).or.(any(nlaggr==0))) then
+    if ((sum(nlaggr) <= target_csize).or.(any(nlaggr==0))) then
       x_sweeps = i
       exit sweeps_loop
     end if
@@ -530,17 +466,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_)
@@ -563,7 +571,6 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
               type(amg_c_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
-              call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
           end select
@@ -612,6 +619,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_)
@@ -713,7 +728,6 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
               type(amg_c_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
-              call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
         end select

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_)
@@ -589,7 +599,6 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
               type(amg_d_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
-              call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
           end select
@@ -638,6 +647,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_)
@@ -753,7 +772,6 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
               type(amg_d_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
-              call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
         end select

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_dslud_interface.c

@@ -94,7 +94,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 #define HANDLE_SIZE  8
 
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63) 
 typedef struct {
   SuperMatrix *A;
   dLUstruct_t *LUstruct;
@@ -135,7 +135,7 @@ int amg_dsludist_fact(int n, int nl, int nnzl, int ffstr,
     SuperMatrix *A;
     NRformat_loc *Astore;
 
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63)
     dScalePermstruct_t *ScalePermstruct;
     dLUstruct_t *LUstruct;
     dSOLVEstruct_t SOLVEstruct;
@@ -148,9 +148,9 @@ int amg_dsludist_fact(int n, int nl, int nnzl, int ffstr,
     int      i, panel_size, permc_spec, relax, info;
     trans_t  trans;
     double   drop_tol = 0.0, b[1], berr[1];
-#if defined(SLUD_VERSION_63) || defined(SLUD_VERSION_6)||defined(SLUD_VERSION_5)
+#if (SLUD_VERSION_>=50)
     superlu_dist_options_t options;
-#elif defined(SLUD_VERSION_4)||defined(SLUD_VERSION_3)
+#elif (SLUD_VERSION_>=30)
     superlu_options_t options;
 #else
     choke_on_me;
@@ -174,7 +174,7 @@ int amg_dsludist_fact(int n, int nl, int nnzl, int ffstr,
 				   SLU_NR_loc, SLU_D, SLU_GE);
     
     /* Initialize ScalePermstruct and LUstruct. */
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63) 
     ScalePermstruct = (dScalePermstruct_t *) SUPERLU_MALLOC(sizeof(dScalePermstruct_t));
     LUstruct = (dLUstruct_t *) SUPERLU_MALLOC(sizeof(dLUstruct_t));
     dScalePermstructInit(n,n, ScalePermstruct);
@@ -183,11 +183,11 @@ int amg_dsludist_fact(int n, int nl, int nnzl, int ffstr,
     LUstruct = (LUstruct_t *) SUPERLU_MALLOC(sizeof(LUstruct_t));
     ScalePermstructInit(n,n, ScalePermstruct);
 #endif
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63) 
     dLUstructInit(n, LUstruct);
-#elif defined(SLUD_VERSION_4) || defined(SLUD_VERSION_5) || defined(SLUD_VERSION_6)
+#elif (SLUD_VERSION_>=40) 
     LUstructInit(n, LUstruct);
-#elif defined(SLUD_VERSION_3) 
+#elif (SLUD_VERSION_>=30)
     LUstructInit(n,n, LUstruct);
 #else
     choke_on_me;
@@ -245,7 +245,7 @@ int amg_dsludist_solve(int itrans, int n, int nrhs,
  */
 #ifdef Have_SLUDist_ 
     SuperMatrix *A;
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63) 
     dScalePermstruct_t *ScalePermstruct;
     dLUstruct_t *LUstruct;
     dSOLVEstruct_t SOLVEstruct;
@@ -259,9 +259,9 @@ int amg_dsludist_solve(int itrans, int n, int nrhs,
     trans_t  trans;
     double   drop_tol = 0.0;
     double *berr;
-#if defined(SLUD_VERSION_63) || defined(SLUD_VERSION_6) ||defined(SLUD_VERSION_5)
+#if (SLUD_VERSION_>=50) 
     superlu_dist_options_t options;
-#elif defined(SLUD_VERSION_4)|| defined(SLUD_VERSION_3)
+#elif (SLUD_VERSION_>=30)
     superlu_options_t options;
 #else
     choke_on_me;
@@ -331,7 +331,7 @@ int amg_dsludist_free(void *f_factors)
  */
 #ifdef Have_SLUDist_ 
     SuperMatrix *A;
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63)
     dScalePermstruct_t *ScalePermstruct;
     dLUstruct_t *LUstruct;
     dSOLVEstruct_t SOLVEstruct;
@@ -345,9 +345,9 @@ int amg_dsludist_free(void *f_factors)
     trans_t  trans;
     double   drop_tol = 0.0;
     double *berr;
-#if defined(SLUD_VERSION_63)||defined(SLUD_VERSION_6)||defined(SLUD_VERSION_5)
+#if (SLUD_VERSION_>=50) 
     superlu_dist_options_t options;
-#elif defined(SLUD_VERSION_4)||defined(SLUD_VERSION_3)
+#elif (SLUD_VERSION_>=30)
     superlu_options_t options;
 #else
     choke_on_me;
@@ -368,7 +368,7 @@ int amg_dsludist_free(void *f_factors)
     // we either have a leak or a segfault here.
     // To be investigated further. 
     //Destroy_CompRowLoc_Matrix_dist(A);
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63)
     dScalePermstructFree(ScalePermstruct);
     dLUstructFree(LUstruct);
 #else

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_)
@@ -563,7 +571,6 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
               type(amg_s_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
-              call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
           end select
@@ -612,6 +619,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_)
@@ -713,7 +728,6 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
               type(amg_s_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
-              call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
         end select

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_)
@@ -589,7 +599,6 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
               type(amg_z_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
-              call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
           end select
@@ -638,6 +647,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_)
@@ -753,7 +772,6 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
               type(amg_z_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos)
               call p%precv(nlev_)%set(krm_slv,info)
-              call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
         end select

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/amg_zslud_interface.c

@@ -94,7 +94,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 #define HANDLE_SIZE  8
 
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63)
 typedef struct {
   SuperMatrix *A;
   zLUstruct_t *LUstruct;
@@ -142,7 +142,7 @@ int amg_zsludist_fact(int n, int nl, int nnzl, int ffstr,
     SuperMatrix *A;
     NRformat_loc *Astore;
 
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63)
     zScalePermstruct_t *ScalePermstruct;
     zLUstruct_t *LUstruct;
     zSOLVEstruct_t SOLVEstruct;
@@ -155,9 +155,9 @@ int amg_zsludist_fact(int n, int nl, int nnzl, int ffstr,
     int      i, panel_size, permc_spec, relax, info;
     trans_t  trans;
     double   drop_tol = 0.0,berr[1];
-#if defined(SLUD_VERSION_63) || defined(SLUD_VERSION_6)||defined(SLUD_VERSION_5)
+#if (SLUD_VERSION_>=50) 
     superlu_dist_options_t options;
-#elif defined(SLUD_VERSION_4)||defined(SLUD_VERSION_3)
+#elif (SLUD_VERSION_>=30)
     superlu_options_t options;
 #else
     choke_on_me;
@@ -181,7 +181,7 @@ int amg_zsludist_fact(int n, int nl, int nnzl, int ffstr,
 				   SLU_NR_loc, SLU_Z, SLU_GE);
     
     /* Initialize ScalePermstruct and LUstruct. */
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63)
     ScalePermstruct = (zScalePermstruct_t *) SUPERLU_MALLOC(sizeof(zScalePermstruct_t));
     LUstruct = (zLUstruct_t *) SUPERLU_MALLOC(sizeof(zLUstruct_t));
     zScalePermstructInit(n,n, ScalePermstruct);
@@ -190,11 +190,11 @@ int amg_zsludist_fact(int n, int nl, int nnzl, int ffstr,
     LUstruct = (LUstruct_t *) SUPERLU_MALLOC(sizeof(LUstruct_t));
     ScalePermstructInit(n,n, ScalePermstruct);
 #endif
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63)
     zLUstructInit(n, LUstruct);
-#elif defined(SLUD_VERSION_4) || defined(SLUD_VERSION_5) || defined(SLUD_VERSION_6)
+#elif (SLUD_VERSION_>=40) 
     LUstructInit(n, LUstruct);
-#elif defined(SLUD_VERSION_3)
+#elif (SLUD_VERSION_>=30)
     LUstructInit(n,n, LUstruct);
 #else
     choke_on_me;
@@ -257,7 +257,7 @@ int amg_zsludist_solve(int itrans, int n, int nrhs,
  */
 #ifdef Have_SLUDist_ 
     SuperMatrix *A;
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63) 
     zScalePermstruct_t *ScalePermstruct;
     zLUstruct_t *LUstruct;
     zSOLVEstruct_t SOLVEstruct;
@@ -271,9 +271,9 @@ int amg_zsludist_solve(int itrans, int n, int nrhs,
     trans_t  trans;
     double   drop_tol = 0.0;
     double *berr;
-#if defined(SLUD_VERSION_63) || defined(SLUD_VERSION_6) ||defined(SLUD_VERSION_5)
+#if (SLUD_VERSION_>=50) 
     superlu_dist_options_t options;
-#elif defined(SLUD_VERSION_4)|| defined(SLUD_VERSION_3)
+#elif (SLUD_VERSION_>=30)
     superlu_options_t options;
 #else
     choke_on_me;
@@ -343,7 +343,7 @@ int amg_zsludist_free(void *f_factors)
  */
 #ifdef Have_SLUDist_ 
     SuperMatrix *A;
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63) 
     zScalePermstruct_t *ScalePermstruct;
     zLUstruct_t *LUstruct;
     zSOLVEstruct_t SOLVEstruct;
@@ -357,9 +357,9 @@ int amg_zsludist_free(void *f_factors)
     trans_t  trans;
     double   drop_tol = 0.0;
     double *berr;
-#if defined(SLUD_VERSION_63)||defined(SLUD_VERSION_6)||defined(SLUD_VERSION_5)
+#if (SLUD_VERSION_>=50) 
     superlu_dist_options_t options;
-#elif defined(SLUD_VERSION_4)||defined(SLUD_VERSION_3)
+#elif (SLUD_VERSION_>=30)
     superlu_options_t options;
 #else
     choke_on_me;
@@ -380,7 +380,7 @@ int amg_zsludist_free(void *f_factors)
     // we either have a leak or a segfault here.
     // To be investigated further. 
     //Destroy_CompRowLoc_Matrix_dist(A);
-#if defined(SLUD_VERSION_63)
+#if (SLUD_VERSION_>=63) 
     zScalePermstructFree(ScalePermstruct);
     zLUstructFree(LUstruct);
 #else

amgprec/impl/level/amg_c_base_onelev_descr.f90

@@ -83,6 +83,8 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity)
   write(iout_,*) 
   if (il == ilmin) then 
     call lv%parms%mlcycledsc(iout_,info)
+  end if
+  if (((ilmin==1).and.(il==2)).or.((ilmin>1).and.(il==ilmin))) then 
     if (allocated(lv%aggr)) then
       call lv%aggr%descr(lv%parms,iout_,info)
     else

amgprec/impl/level/amg_c_base_onelev_dump.f90

@@ -101,7 +101,13 @@ subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
   end if
 
   if (global_num_) then
-    if (level >= 2) then 
+    if (level == 1) then
+      if (ac_) then
+        ivr = lv%base_desc%get_global_indices(owned=.false.)
+        write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
+        call lv%base_a%print(fname,head=head,iv=ivr)
+      end if
+    else if (level >= 2) then 
       if (ac_) then
         ivr = lv%desc_ac%get_global_indices(owned=.false.)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
@@ -126,7 +132,12 @@ subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
       end if
     end if
   else
-    if (level >= 2) then 
+    if (level == 1) then
+      if (ac_) then
+        write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
+        call lv%base_a%print(fname,head=head)
+      end if
+    else  if (level >= 2) then 
       if (ac_) then 
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
         call lv%ac%print(fname,head=head)
@@ -146,16 +157,7 @@ subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
     end if
   end if
   
-  if (level >= 2) then 
-    if (allocated(lv%sm)) then
-      call lv%sm%dump(lv%desc_ac,level,info,smoother=smoother, &
-           & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
-    end if
-    if (allocated(lv%sm2a)) then
-      call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, &
-           & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
-    end if
-  else
+  if (level >= 1) then 
     if (allocated(lv%sm)) then
       call lv%sm%dump(lv%base_desc,level,info,smoother=smoother, &
            & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)

amgprec/impl/level/amg_d_base_onelev_descr.f90

@@ -83,6 +83,8 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity)
   write(iout_,*) 
   if (il == ilmin) then 
     call lv%parms%mlcycledsc(iout_,info)
+  end if
+  if (((ilmin==1).and.(il==2)).or.((ilmin>1).and.(il==ilmin))) then 
     if (allocated(lv%aggr)) then
       call lv%aggr%descr(lv%parms,iout_,info)
     else

amgprec/impl/level/amg_d_base_onelev_dump.f90

@@ -101,7 +101,13 @@ subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
   end if
 
   if (global_num_) then
-    if (level >= 2) then 
+    if (level == 1) then
+      if (ac_) then
+        ivr = lv%base_desc%get_global_indices(owned=.false.)
+        write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
+        call lv%base_a%print(fname,head=head,iv=ivr)
+      end if
+    else if (level >= 2) then 
       if (ac_) then
         ivr = lv%desc_ac%get_global_indices(owned=.false.)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
@@ -126,7 +132,12 @@ subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
       end if
     end if
   else
-    if (level >= 2) then 
+    if (level == 1) then
+      if (ac_) then
+        write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
+        call lv%base_a%print(fname,head=head)
+      end if
+    else  if (level >= 2) then 
       if (ac_) then 
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
         call lv%ac%print(fname,head=head)
@@ -146,16 +157,7 @@ subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
     end if
   end if
   
-  if (level >= 2) then 
-    if (allocated(lv%sm)) then
-      call lv%sm%dump(lv%desc_ac,level,info,smoother=smoother, &
-           & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
-    end if
-    if (allocated(lv%sm2a)) then
-      call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, &
-           & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
-    end if
-  else
+  if (level >= 1) then 
     if (allocated(lv%sm)) then
       call lv%sm%dump(lv%base_desc,level,info,smoother=smoother, &
            & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)

amgprec/impl/level/amg_s_base_onelev_descr.f90

@@ -83,6 +83,8 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity)
   write(iout_,*) 
   if (il == ilmin) then 
     call lv%parms%mlcycledsc(iout_,info)
+  end if
+  if (((ilmin==1).and.(il==2)).or.((ilmin>1).and.(il==ilmin))) then 
     if (allocated(lv%aggr)) then
       call lv%aggr%descr(lv%parms,iout_,info)
     else

amgprec/impl/level/amg_s_base_onelev_dump.f90

@@ -101,7 +101,13 @@ subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
   end if
 
   if (global_num_) then
-    if (level >= 2) then 
+    if (level == 1) then
+      if (ac_) then
+        ivr = lv%base_desc%get_global_indices(owned=.false.)
+        write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
+        call lv%base_a%print(fname,head=head,iv=ivr)
+      end if
+    else if (level >= 2) then 
       if (ac_) then
         ivr = lv%desc_ac%get_global_indices(owned=.false.)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
@@ -126,7 +132,12 @@ subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
       end if
     end if
   else
-    if (level >= 2) then 
+    if (level == 1) then
+      if (ac_) then
+        write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
+        call lv%base_a%print(fname,head=head)
+      end if
+    else  if (level >= 2) then 
       if (ac_) then 
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
         call lv%ac%print(fname,head=head)
@@ -146,16 +157,7 @@ subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
     end if
   end if
   
-  if (level >= 2) then 
-    if (allocated(lv%sm)) then
-      call lv%sm%dump(lv%desc_ac,level,info,smoother=smoother, &
-           & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
-    end if
-    if (allocated(lv%sm2a)) then
-      call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, &
-           & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
-    end if
-  else
+  if (level >= 1) then 
     if (allocated(lv%sm)) then
       call lv%sm%dump(lv%base_desc,level,info,smoother=smoother, &
            & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)

amgprec/impl/level/amg_z_base_onelev_descr.f90

@@ -83,6 +83,8 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity)
   write(iout_,*) 
   if (il == ilmin) then 
     call lv%parms%mlcycledsc(iout_,info)
+  end if
+  if (((ilmin==1).and.(il==2)).or.((ilmin>1).and.(il==ilmin))) then 
     if (allocated(lv%aggr)) then
       call lv%aggr%descr(lv%parms,iout_,info)
     else

amgprec/impl/level/amg_z_base_onelev_dump.f90

@@ -101,7 +101,13 @@ subroutine amg_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
   end if
 
   if (global_num_) then
-    if (level >= 2) then 
+    if (level == 1) then
+      if (ac_) then
+        ivr = lv%base_desc%get_global_indices(owned=.false.)
+        write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
+        call lv%base_a%print(fname,head=head,iv=ivr)
+      end if
+    else if (level >= 2) then 
       if (ac_) then
         ivr = lv%desc_ac%get_global_indices(owned=.false.)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
@@ -126,7 +132,12 @@ subroutine amg_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
       end if
     end if
   else
-    if (level >= 2) then 
+    if (level == 1) then
+      if (ac_) then
+        write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
+        call lv%base_a%print(fname,head=head)
+      end if
+    else  if (level >= 2) then 
       if (ac_) then 
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
         call lv%ac%print(fname,head=head)
@@ -146,16 +157,7 @@ subroutine amg_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
     end if
   end if
   
-  if (level >= 2) then 
-    if (allocated(lv%sm)) then
-      call lv%sm%dump(lv%desc_ac,level,info,smoother=smoother, &
-           & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)
-    end if
-    if (allocated(lv%sm2a)) then
-      call lv%sm2a%dump(lv%desc_ac,level,info,smoother=smoother, &
-           & solver=solver,prefix=trim(prefix_)//"_sm2a",global_num=global_num)
-    end if
-  else
+  if (level >= 1) then 
     if (allocated(lv%sm)) then
       call lv%sm%dump(lv%base_desc,level,info,smoother=smoother, &
            & solver=solver,prefix=trim(prefix_)//"_sm",global_num=global_num)

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