Doc fixes

# Conflicts:
#	docs/amg4psblas_1.0-guide.pdf
#	docs/html/userhtmlse1.html
#	docs/html/userhtmlse4.html
#	docs/html/userhtmlse6.html
#	docs/html/userhtmlsu10.html
#	docs/html/userhtmlsu11.html
#	docs/html/userhtmlsu12.html
#	docs/html/userhtmlsu13.html
#	docs/html/userhtmlsu14.html
#	docs/html/userhtmlsu15.html
#	docs/html/userhtmlsu3.html
#	docs/html/userhtmlsu4.html
#	docs/html/userhtmlsu5.html
#	docs/html/userhtmlsu6.html
#	docs/html/userhtmlsu7.html
#	docs/html/userhtmlsu8.html
#	docs/html/userhtmlsu9.html
#	docs/src/building.tex
#	docs/src/overview.tex

LICENSE

@@ -4,7 +4,7 @@
     Algebraic Multigrid Package
                based on PSBLAS (Parallel Sparse BLAS version 3.7)
     
-    (C) Copyright 2020 
+    (C) Copyright 2021
   
         Salvatore Filippone  
         Pasqua D'Ambra   

amgprec/Makefile

@@ -15,8 +15,7 @@ DMODOBJS=amg_d_prec_type.o \
 	amg_d_base_aggregator_mod.o \
 	amg_d_dec_aggregator_mod.o amg_d_symdec_aggregator_mod.o \
 	amg_d_ainv_solver.o amg_d_base_ainv_mod.o \
-	amg_d_invk_solver.o amg_d_invt_solver.o \
-	amg_d_rkr_solver.o
+	amg_d_invk_solver.o amg_d_invt_solver.o amg_d_rkr_solver.o
 #amg_d_bcmatch_aggregator_mod.o
 
 SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \
@@ -27,8 +26,7 @@ SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \
 	amg_s_base_aggregator_mod.o  \
 	amg_s_dec_aggregator_mod.o amg_s_symdec_aggregator_mod.o \
 	amg_s_ainv_solver.o amg_s_base_ainv_mod.o \
-	amg_s_invk_solver.o amg_s_invt_solver.o \
-	amg_s_rkr_solver.o
+	amg_s_invk_solver.o amg_s_invt_solver.o amg_s_rkr_solver.o
 
 ZMODOBJS=amg_z_prec_type.o amg_z_ilu_fact_mod.o \
 	amg_z_inner_mod.o amg_z_ilu_solver.o amg_z_diag_solver.o amg_z_jac_smoother.o amg_z_as_smoother.o \
@@ -38,8 +36,7 @@ ZMODOBJS=amg_z_prec_type.o amg_z_ilu_fact_mod.o \
 	amg_z_base_aggregator_mod.o  \
 	amg_z_dec_aggregator_mod.o amg_z_symdec_aggregator_mod.o \
 	amg_z_ainv_solver.o amg_z_base_ainv_mod.o \
-	amg_z_invk_solver.o amg_z_invt_solver.o \
-	amg_z_rkr_solver.o
+	amg_z_invk_solver.o amg_z_invt_solver.o amg_z_rkr_solver.o
 
 CMODOBJS=amg_c_prec_type.o amg_c_ilu_fact_mod.o \
 	amg_c_inner_mod.o amg_c_ilu_solver.o amg_c_diag_solver.o amg_c_jac_smoother.o amg_c_as_smoother.o \
@@ -49,8 +46,7 @@ CMODOBJS=amg_c_prec_type.o amg_c_ilu_fact_mod.o \
 	amg_c_base_aggregator_mod.o  \
 	amg_c_dec_aggregator_mod.o amg_c_symdec_aggregator_mod.o \
 	amg_c_ainv_solver.o amg_c_base_ainv_mod.o \
-	amg_c_invk_solver.o amg_c_invt_solver.o \
-	amg_c_rkr_solver.o
+	amg_c_invk_solver.o amg_c_invt_solver.o amg_c_rkr_solver.o
 
 
 
@@ -84,6 +80,15 @@ 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
 amg_prec_type.o: amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o
 amg_prec_mod.o: amg_prec_type.o amg_s_prec_mod.o amg_d_prec_mod.o amg_c_prec_mod.o amg_z_prec_mod.o
+amg_s_rkr_solver.o: amg_s_prec_type.o  amg_s_base_solver_mod.o 
+amg_d_rkr_solver.o: amg_d_prec_type.o  amg_d_base_solver_mod.o 
+amg_c_rkr_solver.o: amg_c_prec_type.o  amg_c_base_solver_mod.o 
+amg_z_rkr_solver.o: amg_z_prec_type.o  amg_z_base_solver_mod.o 	
+
+amg_s_prec_mod.o: amg_s_rkr_solver.o
+amg_d_prec_mod.o: amg_d_rkr_solver.o 
+amg_c_prec_mod.o: amg_c_rkr_solver.o 
+amg_z_prec_mod.o: amg_z_rkr_solver.o 
 
 $(SINNEROBJS) $(SOUTEROBJS): $(SMODOBJS)
 $(DINNEROBJS) $(DOUTEROBJS): $(DMODOBJS)
@@ -141,11 +146,6 @@ amg_c_base_ainv_mod.o: amg_c_base_solver_mod.o amg_base_ainv_mod.o
 amg_d_base_ainv_mod.o: amg_d_base_solver_mod.o amg_base_ainv_mod.o
 amg_z_base_ainv_mod.o: amg_z_base_solver_mod.o amg_base_ainv_mod.o
 
-amg_d_rkr_solver.o: amg_d_base_solver_mod.o amg_d_prec_type.o
-amg_s_rkr_solver.o: amg_s_base_solver_mod.o amg_s_prec_type.o
-amg_c_rkr_solver.o: amg_c_base_solver_mod.o amg_c_prec_type.o
-amg_z_rkr_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.o
-
 amg_s_base_solver_mod.o amg_d_base_solver_mod.o amg_c_base_solver_mod.o amg_z_base_solver_mod.o: amg_base_prec_type.o
 
 amg_d_mumps_solver.o amg_d_gs_solver.o amg_d_id_solver.o amg_d_sludist_solver.o amg_d_slu_solver.o \

amgprec/amg_base_prec_type.F90

@@ -120,7 +120,9 @@ module amg_base_prec_type
     procedure, pass(pm) :: printout => d_ml_parms_printout
   end type amg_dml_parms
 
-  type amg_saggr_data
+  
+
+  type amg_iaggr_data
     !
     ! Aggregation data and defaults:
     !
@@ -129,28 +131,21 @@ module amg_base_prec_type
     !                             We are assuming that the coarse size fits in
     !                             integer range of psb_ipk_, but this is
     !                             not very restrictive
-    integer(psb_ipk_)                  :: min_coarse_size = izero
+    integer(psb_ipk_)                  :: min_coarse_size = -ione
+    integer(psb_ipk_)                  :: min_coarse_size_per_process = -ione
+    integer(psb_lpk_)                  :: target_coarse_size
     ! 2. maximum number of levels.   Defaults to  20 
     integer(psb_ipk_)                  :: max_levs    = 20_psb_ipk_
+  end type amg_iaggr_data
+  
+  type, extends(amg_iaggr_data) :: amg_saggr_data
     ! 3. min_cr_ratio   = 1.5     
     real(psb_spk_)                     :: min_cr_ratio   = 1.5_psb_spk_
     real(psb_spk_)                     :: op_complexity  = szero
     real(psb_spk_)                     :: avg_cr         = szero
   end type amg_saggr_data
 
-  type amg_daggr_data
-    !
-    ! Aggregation data and defaults:
-    !
-    !
-    ! 1. min_coarse_size = 0      Default target size will be computed  as
-    !                               40*(N_fine)**(1./3.)
-    !                             We are assuming that the coarse size fits in
-    !                             integer range of psb_ipk_, but this is
-    !                             not very restrictive
-    integer(psb_ipk_)                  :: min_coarse_size = izero
-    ! 2. maximum number of levels.   Defaults to  20 
-    integer(psb_ipk_)                  :: max_levs    = 20_psb_ipk_
+  type, extends(amg_iaggr_data) :: amg_daggr_data
     ! 3. min_cr_ratio   = 1.5     
     real(psb_dpk_)                     :: min_cr_ratio   = 1.5_psb_dpk_
     real(psb_dpk_)                     :: op_complexity  = dzero
@@ -408,8 +403,28 @@ module amg_base_prec_type
     module procedure amg_d_equal_aggregation, amg_s_equal_aggregation
   end interface amg_equal_aggregation
 
+  !
+  ! default to no remapping.
+  ! Will need a more sophisticated strategy.
+  !
+  logical, private, save :: do_remap=.false.
+  
 contains
+  
+  function amg_get_do_remap() result(res)
+    implicit none
+    logical :: res
 
+    res = do_remap
+  end function amg_get_do_remap
+
+  subroutine amg_set_do_remap(val)
+    implicit none
+    logical, intent(in) :: val
+
+    do_remap = val
+  end subroutine amg_set_do_remap
+  
   !
   ! Function: amg_stringval
   !

amgprec/amg_c_ainv_solver.F90

@@ -58,10 +58,9 @@ module amg_c_ainv_solver
     procedure, pass(sv) :: cseti   => amg_c_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_c_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_c_ainv_solver_csetr
-    procedure, pass(sv) :: seti    => amg_c_ainv_solver_seti
-    procedure, pass(sv) :: setc    => amg_c_ainv_solver_setc
-    procedure, pass(sv) :: setr    => amg_c_ainv_solver_setr
-    generic, public :: set => seti, setr, setc
+!!$    procedure, pass(sv) :: seti    => amg_c_ainv_solver_seti
+!!$    procedure, pass(sv) :: setc    => amg_c_ainv_solver_setc
+!!$    procedure, pass(sv) :: setr    => amg_c_ainv_solver_setr
     procedure, pass(sv) :: descr   => amg_c_ainv_solver_descr
     procedure, pass(sv) :: default => c_ainv_solver_default
     procedure, nopass   :: stringval  => c_ainv_stringval
@@ -159,41 +158,41 @@ module amg_c_ainv_solver
     end subroutine amg_c_ainv_solver_csetr
   end interface
 
-  interface
-    subroutine amg_c_ainv_solver_setc(sv,what,val,info)
-      import :: amg_c_ainv_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_c_ainv_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      character(len=*), intent(in)                 :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_c_ainv_solver_setc
-  end interface
-
-  interface
-    subroutine amg_c_ainv_solver_seti(sv,what,val,info)
-      import :: amg_c_ainv_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_c_ainv_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      integer(psb_ipk_), intent(in)                :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_c_ainv_solver_seti
-  end interface
-
-  interface
-    subroutine amg_c_ainv_solver_setr(sv,what,val,info)
-      import :: amg_c_ainv_solver_type, psb_ipk_, psb_spk_
-      Implicit none
-      ! Arguments
-      class(amg_c_ainv_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      real(psb_spk_), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_c_ainv_solver_setr
-  end interface
+!!$  interface
+!!$    subroutine amg_c_ainv_solver_setc(sv,what,val,info)
+!!$      import :: amg_c_ainv_solver_type, psb_ipk_
+!!$      Implicit none
+!!$      ! Arguments
+!!$      class(amg_c_ainv_solver_type), intent(inout) :: sv
+!!$      integer(psb_ipk_), intent(in)                :: what
+!!$      character(len=*), intent(in)                 :: val
+!!$      integer(psb_ipk_), intent(out)               :: info
+!!$    end subroutine amg_c_ainv_solver_setc
+!!$  end interface
+!!$
+!!$  interface
+!!$    subroutine amg_c_ainv_solver_seti(sv,what,val,info)
+!!$      import :: amg_c_ainv_solver_type, psb_ipk_
+!!$      Implicit none
+!!$      ! Arguments
+!!$      class(amg_c_ainv_solver_type), intent(inout) :: sv
+!!$      integer(psb_ipk_), intent(in)                :: what
+!!$      integer(psb_ipk_), intent(in)                :: val
+!!$      integer(psb_ipk_), intent(out)               :: info
+!!$    end subroutine amg_c_ainv_solver_seti
+!!$  end interface
+!!$
+!!$  interface
+!!$    subroutine amg_c_ainv_solver_setr(sv,what,val,info)
+!!$      import :: amg_c_ainv_solver_type, psb_ipk_, psb_spk_
+!!$      Implicit none
+!!$      ! Arguments
+!!$      class(amg_c_ainv_solver_type), intent(inout) :: sv
+!!$      integer(psb_ipk_), intent(in)                :: what
+!!$      real(psb_spk_), intent(in)                   :: val
+!!$      integer(psb_ipk_), intent(out)               :: info
+!!$    end subroutine amg_c_ainv_solver_setr
+!!$  end interface
 
   interface
     subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse)

amgprec/amg_c_invk_solver.f90

@@ -51,8 +51,6 @@ module amg_c_invk_solver
     procedure, pass(sv) :: clone   => amg_c_invk_solver_clone
     procedure, pass(sv) :: build   => amg_c_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_c_invk_solver_cseti
-    procedure, pass(sv) :: seti    => amg_c_invk_solver_seti
-    generic, public     :: set     => seti
     procedure, pass(sv) :: descr   => amg_c_invk_solver_descr
     procedure, pass(sv) :: default => c_invk_solver_default
   end type amg_c_invk_solver_type
@@ -136,18 +134,6 @@ module amg_c_invk_solver
     end subroutine amg_c_invk_solver_descr
   end interface
 
-  interface
-    subroutine amg_c_invk_solver_seti(sv,what,val,info)
-      import :: amg_c_invk_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_c_invk_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      integer(psb_ipk_), intent(in)                :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_c_invk_solver_seti
-  end interface
-
 contains
 
   subroutine c_invk_solver_default(sv)

amgprec/amg_c_invt_solver.f90

@@ -52,9 +52,6 @@ module amg_c_invt_solver
     procedure, pass(sv) :: build   => amg_c_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_c_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_c_invt_solver_csetr
-    procedure, pass(sv) :: seti    => amg_c_invt_solver_seti
-    procedure, pass(sv) :: setr    => amg_c_invt_solver_setr
-    generic, public     :: set     => seti, setr
     procedure, pass(sv) :: descr   => amg_c_invt_solver_descr
     procedure, pass(sv) :: default => c_invt_solver_default
   end type amg_c_invt_solver_type
@@ -148,30 +145,6 @@ module amg_c_invt_solver
     end subroutine amg_c_invt_solver_descr
   end interface
 
-  interface
-    subroutine amg_c_invt_solver_setr(sv,what,val,info)
-      import :: amg_c_invt_solver_type, psb_spk_, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_c_invt_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      real(psb_spk_), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_c_invt_solver_setr
-  end interface
-
-  interface
-    subroutine amg_c_invt_solver_seti(sv,what,val,info)
-      import :: amg_c_invt_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_c_invt_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      integer(psb_ipk_), intent(in)                :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine
-  end interface
-
 contains
 
   subroutine c_invt_solver_default(sv)

amgprec/amg_c_onelev_mod.f90

@@ -152,6 +152,15 @@ module amg_c_onelev_mod
   end type amg_cmlprec_wrk_type
   private :: c_wrk_alloc, c_wrk_free, &
        & c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv, c_wrk_sizeof    
+
+  type amg_c_remap_data_type
+    type(psb_cspmat_type)          :: ac_pre_remap
+    type(psb_desc_type)            :: desc_ac_pre_remap
+    integer(psb_ipk_)              :: idest
+    integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
+  contains
+    procedure, pass(rmp) :: clone   => c_remap_data_clone
+  end type amg_c_remap_data_type
   
   type amg_c_onelev_type
     class(amg_c_base_smoother_type), allocatable   :: sm, sm2a
@@ -166,7 +175,8 @@ module amg_c_onelev_mod
     type(psb_cspmat_type), pointer   :: base_a    => null() 
     type(psb_desc_type), pointer     :: base_desc => null() 
     type(psb_lcspmat_type)           :: tprol
-    type(psb_clinmap_type)           :: map
+    type(psb_clinmap_type)           :: linmap
+    type(amg_c_remap_data_type)      :: remap_data
     real(psb_spk_)                     :: szratio
   contains
     procedure, pass(lv) :: bld_tprol   => c_base_onelev_bld_tprol
@@ -196,6 +206,13 @@ module amg_c_onelev_mod
     procedure, nopass   :: stringval => amg_stringval
     procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc
     
+    
+    procedure, pass(lv) :: map_rstr_a => amg_c_base_onelev_map_rstr_a
+    procedure, pass(lv) :: map_prol_a => amg_c_base_onelev_map_prol_a
+    procedure, pass(lv) :: map_rstr_v => amg_c_base_onelev_map_rstr_v
+    procedure, pass(lv) :: map_prol_v => amg_c_base_onelev_map_prol_v
+    generic, public     :: map_rstr => map_rstr_a, map_rstr_v
+    generic, public     :: map_prol => map_prol_a, map_prol_v
   end type amg_c_onelev_type
 
   type amg_c_onelev_node
@@ -239,16 +256,17 @@ module amg_c_onelev_mod
   end interface
 
   interface 
-    subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout)
+    subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
            & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
       ! Arguments
-      class(amg_c_onelev_type), intent(in) :: lv
-      integer(psb_ipk_), intent(in)                 :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)                :: info
-      integer(psb_ipk_), intent(in), optional       :: iout
+      class(amg_c_onelev_type), intent(in)    :: lv
+      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
+      integer(psb_ipk_), intent(out)          :: info
+      integer(psb_ipk_), intent(in), optional :: iout
+      integer(psb_ipk_), intent(in), optional :: verbosity
     end subroutine amg_c_base_onelev_descr
   end interface
 
@@ -394,6 +412,53 @@ interface
       logical, optional, intent(in)    :: ac, rp, smoother, solver, tprol, global_num
     end subroutine amg_c_base_onelev_dump
   end interface
+
+  interface
+    subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
+      import
+      implicit none
+      class(amg_c_onelev_type), target, intent(inout) :: lv
+      complex(psb_spk_), intent(in)     :: alpha, beta
+      complex(psb_spk_), intent(inout)   :: u(:)
+      complex(psb_spk_), intent(out)     :: v(:)
+      integer(psb_ipk_), intent(out) :: info
+      complex(psb_spk_), optional       :: work(:)
+    end subroutine amg_c_base_onelev_map_rstr_a
+    subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
+      import
+      implicit none
+      class(amg_c_onelev_type), target, intent(inout) :: lv
+      complex(psb_spk_), intent(in)           :: alpha, beta
+      type(psb_c_vect_type), intent(inout) :: vect_u, vect_v
+      integer(psb_ipk_), intent(out)       :: info
+      complex(psb_spk_), optional          :: work(:)
+      type(psb_c_vect_type), optional, target, intent(inout)  :: vtx,vty
+    end subroutine amg_c_base_onelev_map_rstr_v
+  end interface
+
+  interface 
+    subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
+      import
+      implicit none
+      class(amg_c_onelev_type), target, intent(inout) :: lv
+      complex(psb_spk_), intent(in)     :: alpha, beta
+      complex(psb_spk_), intent(inout)   :: u(:)
+      complex(psb_spk_), intent(out)     :: v(:)
+      integer(psb_ipk_), intent(out) :: info
+      complex(psb_spk_), optional          :: work(:)
+
+    end subroutine amg_c_base_onelev_map_prol_a
+    subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
+      import
+      implicit none
+      class(amg_c_onelev_type), target, intent(inout) :: lv
+      complex(psb_spk_), intent(in)           :: alpha, beta
+      type(psb_c_vect_type), intent(inout) :: vect_u, vect_v
+      integer(psb_ipk_), intent(out)       :: info
+      complex(psb_spk_), optional          :: work(:)
+      type(psb_c_vect_type), optional, target, intent(inout)  :: vtx,vty
+    end subroutine amg_c_base_onelev_map_prol_v
+  end interface
   
 contains
   !
@@ -423,7 +488,7 @@ contains
     val = val + lv%desc_ac%sizeof()
     val = val + lv%ac%sizeof()
     val = val + lv%tprol%sizeof()
-    val = val + lv%map%sizeof() 
+    val = val + lv%linmap%sizeof() 
     if (allocated(lv%sm))   val = val + lv%sm%sizeof()
     if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
     if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -553,7 +618,8 @@ contains
     if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
     if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
     if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
-    if (info == psb_success_) call lv%map%clone(lvout%map,info)
+    if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
+    if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
     lvout%base_a    => lv%base_a
     lvout%base_desc => lv%base_desc
     
@@ -584,7 +650,7 @@ contains
     if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info) 
     if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info) 
     if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info) 
-    if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info) 
+    if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info) 
     b%base_a    => lv%base_a
     b%base_desc => lv%base_desc
     
@@ -639,7 +705,17 @@ contains
     info = psb_success_
     nwv = lv%get_wrksz()
     if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
-    if (info == 0) call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
+    if (info == 0) then
+      if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
+        !
+        !  Need to fix this, we need two different allocations
+        !
+        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
+             & desc2=lv%remap_data%desc_ac_pre_remap)      
+      else
+        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
+      end if
+    end if
     
   end subroutine c_base_onelev_allocate_wrk
 
@@ -659,7 +735,7 @@ contains
     end if
   end subroutine c_base_onelev_free_wrk
   
-  subroutine c_wrk_alloc(wk,nwv,desc,info,vmold)
+  subroutine c_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
     use psb_base_mod
     
     Implicit None
@@ -670,25 +746,67 @@ contains
     type(psb_desc_type), intent(in)                   :: desc
     integer(psb_ipk_), intent(out)                    :: info 
     class(psb_c_base_vect_type), intent(in), optional  :: vmold
+    type(psb_desc_type), intent(in), optional          :: desc2
     !
     integer(psb_ipk_) :: i
 
     info = psb_success_
     call wk%free(info)
-    call psb_geasb(wk%vx2l,desc,info,&
-         & scratch=.true.,mold=vmold)
-    call psb_geasb(wk%vy2l,desc,info,&
-         & scratch=.true.,mold=vmold)
-    call psb_geasb(wk%vtx,desc,info,&
-         & scratch=.true.,mold=vmold)
-    call psb_geasb(wk%vty,desc,info,&
-         & scratch=.true.,mold=vmold)
-    allocate(wk%wv(nwv),stat=info)
-    do i=1,nwv
-      call psb_geasb(wk%wv(i),desc,info,&
+    if  (present(desc2)) then
+!!$      write(0,*) 'Check on wrk_alloc 2',&
+!!$           & desc2%get_local_rows(), desc%get_local_rows(),&
+!!$           & desc2%get_local_cols(),desc%get_local_cols()
+!!$      flush(0)
+      if (desc2%get_local_cols()>desc%get_local_cols()) then
+        call psb_geasb(wk%vx2l,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vy2l,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vtx,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vty,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        allocate(wk%wv(nwv),stat=info)
+        do i=1,nwv
+          call psb_geasb(wk%wv(i),desc2,info,&
+               & scratch=.true.,mold=vmold)
+        end do
+      else
+!!$        write(0,*) 'Check on wrk_alloc 1.5 ',&
+!!$             & desc%get_local_rows(),&
+!!$             & desc%get_local_cols()
+        call psb_geasb(wk%vx2l,desc,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vy2l,desc,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vtx,desc,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vty,desc,info,&
+             & scratch=.true.,mold=vmold)
+        allocate(wk%wv(nwv),stat=info)
+        do i=1,nwv
+          call psb_geasb(wk%wv(i),desc,info,&
+               & scratch=.true.,mold=vmold)
+        end do
+      end if
+    else
+!!$      write(0,*) 'Check on wrk_alloc 1 ',&
+!!$           & desc%get_local_rows(),&
+!!$           & desc%get_local_cols()
+      call psb_geasb(wk%vx2l,desc,info,&
            & scratch=.true.,mold=vmold)
-    end do
-    
+      call psb_geasb(wk%vy2l,desc,info,&
+           & scratch=.true.,mold=vmold)
+      call psb_geasb(wk%vtx,desc,info,&
+           & scratch=.true.,mold=vmold)
+      call psb_geasb(wk%vty,desc,info,&
+           & scratch=.true.,mold=vmold)
+      allocate(wk%wv(nwv),stat=info)
+      do i=1,nwv
+        call psb_geasb(wk%wv(i),desc,info,&
+             & scratch=.true.,mold=vmold)
+      end do
+    end if
   end subroutine c_wrk_alloc
     
   subroutine c_wrk_free(wk,info)
@@ -821,4 +939,24 @@ contains
     end if
   end function c_wrk_sizeof
  
+  subroutine c_remap_data_clone(rmp, remap_out, info)
+    use psb_base_mod
+    implicit none 
+    ! Arguments
+    class(amg_c_remap_data_type), target, intent(inout) :: rmp
+    class(amg_c_remap_data_type), target, intent(inout) :: remap_out
+    integer(psb_ipk_), intent(out)                    :: info 
+    !
+    integer(psb_ipk_) :: i
+
+    info = psb_success_
+
+    call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
+    if (info == psb_success_) &
+         & call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
+    remap_out%idest = rmp%idest
+    call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
+    call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)    
+  end subroutine c_remap_data_clone
+  
 end module amg_c_onelev_mod

amgprec/amg_c_prec_mod.f90

@@ -55,12 +55,7 @@ module amg_c_prec_mod
   use amg_c_ainv_solver
   use amg_c_invk_solver
   use amg_c_invt_solver
-
-  interface amg_precset
-    module procedure amg_c_iprecsetsm, amg_c_iprecsetsv, &
-         & amg_c_cprecseti, amg_c_cprecsetc, amg_c_cprecsetr, &
-         & amg_c_iprecsetag
-  end interface amg_precset
+  use amg_c_rkr_solver
 
   interface amg_extprol_bld
     subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
@@ -82,61 +77,4 @@ module amg_c_prec_mod
     end subroutine amg_c_extprol_bld
   end interface amg_extprol_bld
 
-contains
-
-  subroutine amg_c_iprecsetsm(p,val,info,pos)
-    type(amg_cprec_type), intent(inout)    :: p
-    class(amg_c_base_smoother_type), intent(in)   :: val
-    integer(psb_ipk_), intent(out)           :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(val,info,pos=pos)
-  end subroutine amg_c_iprecsetsm
-
-  subroutine amg_c_iprecsetsv(p,val,info,pos)
-    type(amg_cprec_type), intent(inout)    :: p
-    class(amg_c_base_solver_type), intent(in)   :: val
-    integer(psb_ipk_), intent(out)                :: info
-    character(len=*), optional, intent(in)      :: pos
-    call p%set(val,info, pos=pos)
-  end subroutine amg_c_iprecsetsv
-
-  subroutine amg_c_iprecsetag(p,val,info,pos)
-    type(amg_cprec_type), intent(inout)    :: p
-    class(amg_c_base_aggregator_type), intent(in)   :: val
-    integer(psb_ipk_), intent(out)                :: info
-    character(len=*), optional, intent(in)      :: pos
-    call p%set(val,info, pos=pos)
-  end subroutine amg_c_iprecsetag
-
-  subroutine amg_c_cprecseti(p,what,val,info,pos)
-    type(amg_cprec_type), intent(inout)   :: p
-    character(len=*), intent(in)            :: what
-    integer(psb_ipk_), intent(in)           :: val
-    integer(psb_ipk_), intent(out)          :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(what,val,info,pos=pos)
-  end subroutine amg_c_cprecseti
-
-  subroutine amg_c_cprecsetr(p,what,val,info,pos)
-    type(amg_cprec_type), intent(inout)   :: p
-    character(len=*), intent(in)            :: what
-    real(psb_spk_), intent(in)             :: val
-    integer(psb_ipk_), intent(out)          :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(what,val,info,pos=pos)
-  end subroutine amg_c_cprecsetr
-
-  subroutine amg_c_cprecsetc(p,what,val,info,pos)
-    type(amg_cprec_type), intent(inout)   :: p
-    character(len=*), intent(in)            :: what
-    character(len=*), intent(in)            :: val
-    integer(psb_ipk_), intent(out)          :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(what,val,info,pos=pos)
-  end subroutine amg_c_cprecsetc
-
 end module amg_c_prec_mod

amgprec/amg_c_prec_type.f90

@@ -155,13 +155,14 @@ module amg_c_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_cfile_prec_descr(prec,iout,root)
+    subroutine amg_cfile_prec_descr(prec,iout,root,verbosity)
       import :: amg_cprec_type, psb_ipk_
       implicit none
       ! Arguments
       class(amg_cprec_type), intent(in)      :: prec
       integer(psb_ipk_), intent(in), optional :: iout
       integer(psb_ipk_), intent(in), optional :: root
+      integer(psb_ipk_), intent(in), optional :: verbosity
     end subroutine amg_cfile_prec_descr
   end interface
 
@@ -424,11 +425,22 @@ contains
     end if
   end function amg_c_get_nzeros
 
-  function amg_cprec_sizeof(prec) result(val)
+  function amg_cprec_sizeof(prec, global) result(val)
     implicit none
     class(amg_cprec_type), intent(in) :: prec
-    integer(psb_epk_) :: val
+    logical, intent(in), optional :: global
+    integer(psb_epk_) :: val    
     integer(psb_ipk_)        :: i
+    type(psb_ctxt_type) :: ctxt
+    
+    logical :: global_
+
+    if (present(global)) then
+      global_ = global
+    else
+      global_ = .false.
+    end if
+    
     val = 0
     val = val + psb_sizeof_ip
     if (allocated(prec%precv)) then
@@ -436,6 +448,11 @@ contains
         val = val + prec%precv(i)%sizeof()
       end do
     end if
+    if (global_) then
+      ctxt = prec%ctxt
+      call psb_sum(ctxt,val)
+    end if
+
   end function amg_cprec_sizeof
 
   !
@@ -738,16 +755,15 @@ contains
     character(len=*), intent(in), optional  :: prefix, head
     logical, optional, intent(in)    :: smoother, solver,ac, rp, tprol, global_num
     integer(psb_ipk_)   :: i, j, il1, iln, lev
-    type(psb_ctxt_type) :: icontxt
+    type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_)   :: iam, np, iproc_
     character(len=80)   :: prefix_
     character(len=120)  :: fname ! len should be at least 20 more than
     !  len of prefix_
 
     info = 0
-    icontxt = prec%ctxt
-    call psb_info(icontxt,iam,np)
-
+    ctxt = prec%ctxt
+    call psb_info(ctxt,iam,np)
     iln = size(prec%precv)
     if (present(istart)) then
       il1 = max(1,istart)
@@ -812,13 +828,13 @@ contains
     integer(psb_ipk_), intent(out)             :: info
     ! Local vars
     integer(psb_ipk_)   :: i, j, ln, lev
-    type(psb_ctxt_type) :: icontxt
+    type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_)   :: iam, np
 
     info = psb_success_
     select type(pout => precout)
     class is (amg_cprec_type)
-      pout%ctxt         = prec%ctxt
+      pout%ctxt          = prec%ctxt
       pout%ag_data       = prec%ag_data
       pout%outer_sweeps  = prec%outer_sweeps
       if (allocated(prec%precv)) then
@@ -834,8 +850,8 @@ contains
           if (info == psb_success_) then
             pout%precv(lev)%base_a       => pout%precv(lev)%ac
             pout%precv(lev)%base_desc    => pout%precv(lev)%desc_ac
-            pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
-            pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
+            pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
+            pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
           end if
         end do
       end if
@@ -875,8 +891,8 @@ contains
       do i=2, size(b%precv)
         b%precv(i)%base_a    => b%precv(i)%ac
         b%precv(i)%base_desc => b%precv(i)%desc_ac
-        b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
-        b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
+        b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
+        b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
       end do
 
     else

amgprec/amg_d_ainv_solver.F90

@@ -58,10 +58,9 @@ module amg_d_ainv_solver
     procedure, pass(sv) :: cseti   => amg_d_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_d_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_d_ainv_solver_csetr
-    procedure, pass(sv) :: seti    => amg_d_ainv_solver_seti
-    procedure, pass(sv) :: setc    => amg_d_ainv_solver_setc
-    procedure, pass(sv) :: setr    => amg_d_ainv_solver_setr
-    generic, public :: set => seti, setr, setc
+!!$    procedure, pass(sv) :: seti    => amg_d_ainv_solver_seti
+!!$    procedure, pass(sv) :: setc    => amg_d_ainv_solver_setc
+!!$    procedure, pass(sv) :: setr    => amg_d_ainv_solver_setr
     procedure, pass(sv) :: descr   => amg_d_ainv_solver_descr
     procedure, pass(sv) :: default => d_ainv_solver_default
     procedure, nopass   :: stringval  => d_ainv_stringval
@@ -159,41 +158,41 @@ module amg_d_ainv_solver
     end subroutine amg_d_ainv_solver_csetr
   end interface
 
-  interface
-    subroutine amg_d_ainv_solver_setc(sv,what,val,info)
-      import :: amg_d_ainv_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_d_ainv_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      character(len=*), intent(in)                 :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_d_ainv_solver_setc
-  end interface
-
-  interface
-    subroutine amg_d_ainv_solver_seti(sv,what,val,info)
-      import :: amg_d_ainv_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_d_ainv_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      integer(psb_ipk_), intent(in)                :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_d_ainv_solver_seti
-  end interface
-
-  interface
-    subroutine amg_d_ainv_solver_setr(sv,what,val,info)
-      import :: amg_d_ainv_solver_type, psb_ipk_, psb_dpk_
-      Implicit none
-      ! Arguments
-      class(amg_d_ainv_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      real(psb_dpk_), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_d_ainv_solver_setr
-  end interface
+!!$  interface
+!!$    subroutine amg_d_ainv_solver_setc(sv,what,val,info)
+!!$      import :: amg_d_ainv_solver_type, psb_ipk_
+!!$      Implicit none
+!!$      ! Arguments
+!!$      class(amg_d_ainv_solver_type), intent(inout) :: sv
+!!$      integer(psb_ipk_), intent(in)                :: what
+!!$      character(len=*), intent(in)                 :: val
+!!$      integer(psb_ipk_), intent(out)               :: info
+!!$    end subroutine amg_d_ainv_solver_setc
+!!$  end interface
+!!$
+!!$  interface
+!!$    subroutine amg_d_ainv_solver_seti(sv,what,val,info)
+!!$      import :: amg_d_ainv_solver_type, psb_ipk_
+!!$      Implicit none
+!!$      ! Arguments
+!!$      class(amg_d_ainv_solver_type), intent(inout) :: sv
+!!$      integer(psb_ipk_), intent(in)                :: what
+!!$      integer(psb_ipk_), intent(in)                :: val
+!!$      integer(psb_ipk_), intent(out)               :: info
+!!$    end subroutine amg_d_ainv_solver_seti
+!!$  end interface
+!!$
+!!$  interface
+!!$    subroutine amg_d_ainv_solver_setr(sv,what,val,info)
+!!$      import :: amg_d_ainv_solver_type, psb_ipk_, psb_dpk_
+!!$      Implicit none
+!!$      ! Arguments
+!!$      class(amg_d_ainv_solver_type), intent(inout) :: sv
+!!$      integer(psb_ipk_), intent(in)                :: what
+!!$      real(psb_dpk_), intent(in)                   :: val
+!!$      integer(psb_ipk_), intent(out)               :: info
+!!$    end subroutine amg_d_ainv_solver_setr
+!!$  end interface
 
   interface
     subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse)

amgprec/amg_d_invk_solver.f90

@@ -51,8 +51,6 @@ module amg_d_invk_solver
     procedure, pass(sv) :: clone   => amg_d_invk_solver_clone
     procedure, pass(sv) :: build   => amg_d_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_d_invk_solver_cseti
-    procedure, pass(sv) :: seti    => amg_d_invk_solver_seti
-    generic, public     :: set     => seti
     procedure, pass(sv) :: descr   => amg_d_invk_solver_descr
     procedure, pass(sv) :: default => d_invk_solver_default
   end type amg_d_invk_solver_type
@@ -136,18 +134,6 @@ module amg_d_invk_solver
     end subroutine amg_d_invk_solver_descr
   end interface
 
-  interface
-    subroutine amg_d_invk_solver_seti(sv,what,val,info)
-      import :: amg_d_invk_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_d_invk_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      integer(psb_ipk_), intent(in)                :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_d_invk_solver_seti
-  end interface
-
 contains
 
   subroutine d_invk_solver_default(sv)

amgprec/amg_d_invt_solver.f90

@@ -52,9 +52,6 @@ module amg_d_invt_solver
     procedure, pass(sv) :: build   => amg_d_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_d_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_d_invt_solver_csetr
-    procedure, pass(sv) :: seti    => amg_d_invt_solver_seti
-    procedure, pass(sv) :: setr    => amg_d_invt_solver_setr
-    generic, public     :: set     => seti, setr
     procedure, pass(sv) :: descr   => amg_d_invt_solver_descr
     procedure, pass(sv) :: default => d_invt_solver_default
   end type amg_d_invt_solver_type
@@ -148,30 +145,6 @@ module amg_d_invt_solver
     end subroutine amg_d_invt_solver_descr
   end interface
 
-  interface
-    subroutine amg_d_invt_solver_setr(sv,what,val,info)
-      import :: amg_d_invt_solver_type, psb_dpk_, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_d_invt_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      real(psb_dpk_), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_d_invt_solver_setr
-  end interface
-
-  interface
-    subroutine amg_d_invt_solver_seti(sv,what,val,info)
-      import :: amg_d_invt_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_d_invt_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      integer(psb_ipk_), intent(in)                :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine
-  end interface
-
 contains
 
   subroutine d_invt_solver_default(sv)

amgprec/amg_d_onelev_mod.f90

@@ -152,6 +152,15 @@ module amg_d_onelev_mod
   end type amg_dmlprec_wrk_type
   private :: d_wrk_alloc, d_wrk_free, &
        & d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv, d_wrk_sizeof    
+
+  type amg_d_remap_data_type
+    type(psb_dspmat_type)          :: ac_pre_remap
+    type(psb_desc_type)            :: desc_ac_pre_remap
+    integer(psb_ipk_)              :: idest
+    integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
+  contains
+    procedure, pass(rmp) :: clone   => d_remap_data_clone
+  end type amg_d_remap_data_type
   
   type amg_d_onelev_type
     class(amg_d_base_smoother_type), allocatable   :: sm, sm2a
@@ -166,7 +175,8 @@ module amg_d_onelev_mod
     type(psb_dspmat_type), pointer   :: base_a    => null() 
     type(psb_desc_type), pointer     :: base_desc => null() 
     type(psb_ldspmat_type)           :: tprol
-    type(psb_dlinmap_type)           :: map
+    type(psb_dlinmap_type)           :: linmap
+    type(amg_d_remap_data_type)      :: remap_data
     real(psb_dpk_)                     :: szratio
   contains
     procedure, pass(lv) :: bld_tprol   => d_base_onelev_bld_tprol
@@ -196,6 +206,13 @@ module amg_d_onelev_mod
     procedure, nopass   :: stringval => amg_stringval
     procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc
     
+    
+    procedure, pass(lv) :: map_rstr_a => amg_d_base_onelev_map_rstr_a
+    procedure, pass(lv) :: map_prol_a => amg_d_base_onelev_map_prol_a
+    procedure, pass(lv) :: map_rstr_v => amg_d_base_onelev_map_rstr_v
+    procedure, pass(lv) :: map_prol_v => amg_d_base_onelev_map_prol_v
+    generic, public     :: map_rstr => map_rstr_a, map_rstr_v
+    generic, public     :: map_prol => map_prol_a, map_prol_v
   end type amg_d_onelev_type
 
   type amg_d_onelev_node
@@ -239,16 +256,17 @@ module amg_d_onelev_mod
   end interface
 
   interface 
-    subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout)
+    subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
            & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
       ! Arguments
-      class(amg_d_onelev_type), intent(in) :: lv
-      integer(psb_ipk_), intent(in)                 :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)                :: info
-      integer(psb_ipk_), intent(in), optional       :: iout
+      class(amg_d_onelev_type), intent(in)    :: lv
+      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
+      integer(psb_ipk_), intent(out)          :: info
+      integer(psb_ipk_), intent(in), optional :: iout
+      integer(psb_ipk_), intent(in), optional :: verbosity
     end subroutine amg_d_base_onelev_descr
   end interface
 
@@ -394,6 +412,53 @@ interface
       logical, optional, intent(in)    :: ac, rp, smoother, solver, tprol, global_num
     end subroutine amg_d_base_onelev_dump
   end interface
+
+  interface
+    subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
+      import
+      implicit none
+      class(amg_d_onelev_type), target, intent(inout) :: lv
+      real(psb_dpk_), intent(in)     :: alpha, beta
+      real(psb_dpk_), intent(inout)   :: u(:)
+      real(psb_dpk_), intent(out)     :: v(:)
+      integer(psb_ipk_), intent(out) :: info
+      real(psb_dpk_), optional       :: work(:)
+    end subroutine amg_d_base_onelev_map_rstr_a
+    subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
+      import
+      implicit none
+      class(amg_d_onelev_type), target, intent(inout) :: lv
+      real(psb_dpk_), intent(in)           :: alpha, beta
+      type(psb_d_vect_type), intent(inout) :: vect_u, vect_v
+      integer(psb_ipk_), intent(out)       :: info
+      real(psb_dpk_), optional          :: work(:)
+      type(psb_d_vect_type), optional, target, intent(inout)  :: vtx,vty
+    end subroutine amg_d_base_onelev_map_rstr_v
+  end interface
+
+  interface 
+    subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
+      import
+      implicit none
+      class(amg_d_onelev_type), target, intent(inout) :: lv
+      real(psb_dpk_), intent(in)     :: alpha, beta
+      real(psb_dpk_), intent(inout)   :: u(:)
+      real(psb_dpk_), intent(out)     :: v(:)
+      integer(psb_ipk_), intent(out) :: info
+      real(psb_dpk_), optional          :: work(:)
+
+    end subroutine amg_d_base_onelev_map_prol_a
+    subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
+      import
+      implicit none
+      class(amg_d_onelev_type), target, intent(inout) :: lv
+      real(psb_dpk_), intent(in)           :: alpha, beta
+      type(psb_d_vect_type), intent(inout) :: vect_u, vect_v
+      integer(psb_ipk_), intent(out)       :: info
+      real(psb_dpk_), optional          :: work(:)
+      type(psb_d_vect_type), optional, target, intent(inout)  :: vtx,vty
+    end subroutine amg_d_base_onelev_map_prol_v
+  end interface
   
 contains
   !
@@ -423,7 +488,7 @@ contains
     val = val + lv%desc_ac%sizeof()
     val = val + lv%ac%sizeof()
     val = val + lv%tprol%sizeof()
-    val = val + lv%map%sizeof() 
+    val = val + lv%linmap%sizeof() 
     if (allocated(lv%sm))   val = val + lv%sm%sizeof()
     if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
     if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -553,7 +618,8 @@ contains
     if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
     if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
     if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
-    if (info == psb_success_) call lv%map%clone(lvout%map,info)
+    if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
+    if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
     lvout%base_a    => lv%base_a
     lvout%base_desc => lv%base_desc
     
@@ -584,7 +650,7 @@ contains
     if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info) 
     if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info) 
     if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info) 
-    if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info) 
+    if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info) 
     b%base_a    => lv%base_a
     b%base_desc => lv%base_desc
     
@@ -639,7 +705,17 @@ contains
     info = psb_success_
     nwv = lv%get_wrksz()
     if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
-    if (info == 0) call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
+    if (info == 0) then
+      if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
+        !
+        !  Need to fix this, we need two different allocations
+        !
+        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
+             & desc2=lv%remap_data%desc_ac_pre_remap)      
+      else
+        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
+      end if
+    end if
     
   end subroutine d_base_onelev_allocate_wrk
 
@@ -659,7 +735,7 @@ contains
     end if
   end subroutine d_base_onelev_free_wrk
   
-  subroutine d_wrk_alloc(wk,nwv,desc,info,vmold)
+  subroutine d_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
     use psb_base_mod
     
     Implicit None
@@ -670,25 +746,67 @@ contains
     type(psb_desc_type), intent(in)                   :: desc
     integer(psb_ipk_), intent(out)                    :: info 
     class(psb_d_base_vect_type), intent(in), optional  :: vmold
+    type(psb_desc_type), intent(in), optional          :: desc2
     !
     integer(psb_ipk_) :: i
 
     info = psb_success_
     call wk%free(info)
-    call psb_geasb(wk%vx2l,desc,info,&
-         & scratch=.true.,mold=vmold)
-    call psb_geasb(wk%vy2l,desc,info,&
-         & scratch=.true.,mold=vmold)
-    call psb_geasb(wk%vtx,desc,info,&
-         & scratch=.true.,mold=vmold)
-    call psb_geasb(wk%vty,desc,info,&
-         & scratch=.true.,mold=vmold)
-    allocate(wk%wv(nwv),stat=info)
-    do i=1,nwv
-      call psb_geasb(wk%wv(i),desc,info,&
+    if  (present(desc2)) then
+!!$      write(0,*) 'Check on wrk_alloc 2',&
+!!$           & desc2%get_local_rows(), desc%get_local_rows(),&
+!!$           & desc2%get_local_cols(),desc%get_local_cols()
+!!$      flush(0)
+      if (desc2%get_local_cols()>desc%get_local_cols()) then
+        call psb_geasb(wk%vx2l,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vy2l,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vtx,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vty,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        allocate(wk%wv(nwv),stat=info)
+        do i=1,nwv
+          call psb_geasb(wk%wv(i),desc2,info,&
+               & scratch=.true.,mold=vmold)
+        end do
+      else
+!!$        write(0,*) 'Check on wrk_alloc 1.5 ',&
+!!$             & desc%get_local_rows(),&
+!!$             & desc%get_local_cols()
+        call psb_geasb(wk%vx2l,desc,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vy2l,desc,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vtx,desc,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vty,desc,info,&
+             & scratch=.true.,mold=vmold)
+        allocate(wk%wv(nwv),stat=info)
+        do i=1,nwv
+          call psb_geasb(wk%wv(i),desc,info,&
+               & scratch=.true.,mold=vmold)
+        end do
+      end if
+    else
+!!$      write(0,*) 'Check on wrk_alloc 1 ',&
+!!$           & desc%get_local_rows(),&
+!!$           & desc%get_local_cols()
+      call psb_geasb(wk%vx2l,desc,info,&
            & scratch=.true.,mold=vmold)
-    end do
-    
+      call psb_geasb(wk%vy2l,desc,info,&
+           & scratch=.true.,mold=vmold)
+      call psb_geasb(wk%vtx,desc,info,&
+           & scratch=.true.,mold=vmold)
+      call psb_geasb(wk%vty,desc,info,&
+           & scratch=.true.,mold=vmold)
+      allocate(wk%wv(nwv),stat=info)
+      do i=1,nwv
+        call psb_geasb(wk%wv(i),desc,info,&
+             & scratch=.true.,mold=vmold)
+      end do
+    end if
   end subroutine d_wrk_alloc
     
   subroutine d_wrk_free(wk,info)
@@ -821,4 +939,24 @@ contains
     end if
   end function d_wrk_sizeof
  
+  subroutine d_remap_data_clone(rmp, remap_out, info)
+    use psb_base_mod
+    implicit none 
+    ! Arguments
+    class(amg_d_remap_data_type), target, intent(inout) :: rmp
+    class(amg_d_remap_data_type), target, intent(inout) :: remap_out
+    integer(psb_ipk_), intent(out)                    :: info 
+    !
+    integer(psb_ipk_) :: i
+
+    info = psb_success_
+
+    call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
+    if (info == psb_success_) &
+         & call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
+    remap_out%idest = rmp%idest
+    call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
+    call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)    
+  end subroutine d_remap_data_clone
+  
 end module amg_d_onelev_mod

amgprec/amg_d_prec_mod.f90

@@ -55,12 +55,7 @@ module amg_d_prec_mod
   use amg_d_ainv_solver
   use amg_d_invk_solver
   use amg_d_invt_solver
-
-  interface amg_precset
-    module procedure amg_d_iprecsetsm, amg_d_iprecsetsv, &
-         & amg_d_cprecseti, amg_d_cprecsetc, amg_d_cprecsetr, &
-         & amg_d_iprecsetag
-  end interface amg_precset
+  use amg_d_rkr_solver
 
   interface amg_extprol_bld
     subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
@@ -82,61 +77,4 @@ module amg_d_prec_mod
     end subroutine amg_d_extprol_bld
   end interface amg_extprol_bld
 
-contains
-
-  subroutine amg_d_iprecsetsm(p,val,info,pos)
-    type(amg_dprec_type), intent(inout)    :: p
-    class(amg_d_base_smoother_type), intent(in)   :: val
-    integer(psb_ipk_), intent(out)           :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(val,info,pos=pos)
-  end subroutine amg_d_iprecsetsm
-
-  subroutine amg_d_iprecsetsv(p,val,info,pos)
-    type(amg_dprec_type), intent(inout)    :: p
-    class(amg_d_base_solver_type), intent(in)   :: val
-    integer(psb_ipk_), intent(out)                :: info
-    character(len=*), optional, intent(in)      :: pos
-    call p%set(val,info, pos=pos)
-  end subroutine amg_d_iprecsetsv
-
-  subroutine amg_d_iprecsetag(p,val,info,pos)
-    type(amg_dprec_type), intent(inout)    :: p
-    class(amg_d_base_aggregator_type), intent(in)   :: val
-    integer(psb_ipk_), intent(out)                :: info
-    character(len=*), optional, intent(in)      :: pos
-    call p%set(val,info, pos=pos)
-  end subroutine amg_d_iprecsetag
-
-  subroutine amg_d_cprecseti(p,what,val,info,pos)
-    type(amg_dprec_type), intent(inout)   :: p
-    character(len=*), intent(in)            :: what
-    integer(psb_ipk_), intent(in)           :: val
-    integer(psb_ipk_), intent(out)          :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(what,val,info,pos=pos)
-  end subroutine amg_d_cprecseti
-
-  subroutine amg_d_cprecsetr(p,what,val,info,pos)
-    type(amg_dprec_type), intent(inout)   :: p
-    character(len=*), intent(in)            :: what
-    real(psb_dpk_), intent(in)             :: val
-    integer(psb_ipk_), intent(out)          :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(what,val,info,pos=pos)
-  end subroutine amg_d_cprecsetr
-
-  subroutine amg_d_cprecsetc(p,what,val,info,pos)
-    type(amg_dprec_type), intent(inout)   :: p
-    character(len=*), intent(in)            :: what
-    character(len=*), intent(in)            :: val
-    integer(psb_ipk_), intent(out)          :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(what,val,info,pos=pos)
-  end subroutine amg_d_cprecsetc
-
 end module amg_d_prec_mod

amgprec/amg_d_prec_type.f90

@@ -155,13 +155,14 @@ module amg_d_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_dfile_prec_descr(prec,iout,root)
+    subroutine amg_dfile_prec_descr(prec,iout,root,verbosity)
       import :: amg_dprec_type, psb_ipk_
       implicit none
       ! Arguments
       class(amg_dprec_type), intent(in)      :: prec
       integer(psb_ipk_), intent(in), optional :: iout
       integer(psb_ipk_), intent(in), optional :: root
+      integer(psb_ipk_), intent(in), optional :: verbosity
     end subroutine amg_dfile_prec_descr
   end interface
 
@@ -424,11 +425,22 @@ contains
     end if
   end function amg_d_get_nzeros
 
-  function amg_dprec_sizeof(prec) result(val)
+  function amg_dprec_sizeof(prec, global) result(val)
     implicit none
     class(amg_dprec_type), intent(in) :: prec
-    integer(psb_epk_) :: val
+    logical, intent(in), optional :: global
+    integer(psb_epk_) :: val    
     integer(psb_ipk_)        :: i
+    type(psb_ctxt_type) :: ctxt
+    
+    logical :: global_
+
+    if (present(global)) then
+      global_ = global
+    else
+      global_ = .false.
+    end if
+    
     val = 0
     val = val + psb_sizeof_ip
     if (allocated(prec%precv)) then
@@ -436,6 +448,11 @@ contains
         val = val + prec%precv(i)%sizeof()
       end do
     end if
+    if (global_) then
+      ctxt = prec%ctxt
+      call psb_sum(ctxt,val)
+    end if
+
   end function amg_dprec_sizeof
 
   !
@@ -738,16 +755,15 @@ contains
     character(len=*), intent(in), optional  :: prefix, head
     logical, optional, intent(in)    :: smoother, solver,ac, rp, tprol, global_num
     integer(psb_ipk_)   :: i, j, il1, iln, lev
-    type(psb_ctxt_type) :: icontxt
+    type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_)   :: iam, np, iproc_
     character(len=80)   :: prefix_
     character(len=120)  :: fname ! len should be at least 20 more than
     !  len of prefix_
 
     info = 0
-    icontxt = prec%ctxt
-    call psb_info(icontxt,iam,np)
-
+    ctxt = prec%ctxt
+    call psb_info(ctxt,iam,np)
     iln = size(prec%precv)
     if (present(istart)) then
       il1 = max(1,istart)
@@ -812,13 +828,13 @@ contains
     integer(psb_ipk_), intent(out)             :: info
     ! Local vars
     integer(psb_ipk_)   :: i, j, ln, lev
-    type(psb_ctxt_type) :: icontxt
+    type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_)   :: iam, np
 
     info = psb_success_
     select type(pout => precout)
     class is (amg_dprec_type)
-      pout%ctxt         = prec%ctxt
+      pout%ctxt          = prec%ctxt
       pout%ag_data       = prec%ag_data
       pout%outer_sweeps  = prec%outer_sweeps
       if (allocated(prec%precv)) then
@@ -834,8 +850,8 @@ contains
           if (info == psb_success_) then
             pout%precv(lev)%base_a       => pout%precv(lev)%ac
             pout%precv(lev)%base_desc    => pout%precv(lev)%desc_ac
-            pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
-            pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
+            pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
+            pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
           end if
         end do
       end if
@@ -875,8 +891,8 @@ contains
       do i=2, size(b%precv)
         b%precv(i)%base_a    => b%precv(i)%ac
         b%precv(i)%base_desc => b%precv(i)%desc_ac
-        b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
-        b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
+        b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
+        b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
       end do
 
     else

amgprec/amg_s_ainv_solver.F90

@@ -58,10 +58,9 @@ module amg_s_ainv_solver
     procedure, pass(sv) :: cseti   => amg_s_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_s_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_s_ainv_solver_csetr
-    procedure, pass(sv) :: seti    => amg_s_ainv_solver_seti
-    procedure, pass(sv) :: setc    => amg_s_ainv_solver_setc
-    procedure, pass(sv) :: setr    => amg_s_ainv_solver_setr
-    generic, public :: set => seti, setr, setc
+!!$    procedure, pass(sv) :: seti    => amg_s_ainv_solver_seti
+!!$    procedure, pass(sv) :: setc    => amg_s_ainv_solver_setc
+!!$    procedure, pass(sv) :: setr    => amg_s_ainv_solver_setr
     procedure, pass(sv) :: descr   => amg_s_ainv_solver_descr
     procedure, pass(sv) :: default => s_ainv_solver_default
     procedure, nopass   :: stringval  => s_ainv_stringval
@@ -159,41 +158,41 @@ module amg_s_ainv_solver
     end subroutine amg_s_ainv_solver_csetr
   end interface
 
-  interface
-    subroutine amg_s_ainv_solver_setc(sv,what,val,info)
-      import :: amg_s_ainv_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_s_ainv_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      character(len=*), intent(in)                 :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_s_ainv_solver_setc
-  end interface
-
-  interface
-    subroutine amg_s_ainv_solver_seti(sv,what,val,info)
-      import :: amg_s_ainv_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_s_ainv_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      integer(psb_ipk_), intent(in)                :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_s_ainv_solver_seti
-  end interface
-
-  interface
-    subroutine amg_s_ainv_solver_setr(sv,what,val,info)
-      import :: amg_s_ainv_solver_type, psb_ipk_, psb_spk_
-      Implicit none
-      ! Arguments
-      class(amg_s_ainv_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      real(psb_spk_), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_s_ainv_solver_setr
-  end interface
+!!$  interface
+!!$    subroutine amg_s_ainv_solver_setc(sv,what,val,info)
+!!$      import :: amg_s_ainv_solver_type, psb_ipk_
+!!$      Implicit none
+!!$      ! Arguments
+!!$      class(amg_s_ainv_solver_type), intent(inout) :: sv
+!!$      integer(psb_ipk_), intent(in)                :: what
+!!$      character(len=*), intent(in)                 :: val
+!!$      integer(psb_ipk_), intent(out)               :: info
+!!$    end subroutine amg_s_ainv_solver_setc
+!!$  end interface
+!!$
+!!$  interface
+!!$    subroutine amg_s_ainv_solver_seti(sv,what,val,info)
+!!$      import :: amg_s_ainv_solver_type, psb_ipk_
+!!$      Implicit none
+!!$      ! Arguments
+!!$      class(amg_s_ainv_solver_type), intent(inout) :: sv
+!!$      integer(psb_ipk_), intent(in)                :: what
+!!$      integer(psb_ipk_), intent(in)                :: val
+!!$      integer(psb_ipk_), intent(out)               :: info
+!!$    end subroutine amg_s_ainv_solver_seti
+!!$  end interface
+!!$
+!!$  interface
+!!$    subroutine amg_s_ainv_solver_setr(sv,what,val,info)
+!!$      import :: amg_s_ainv_solver_type, psb_ipk_, psb_spk_
+!!$      Implicit none
+!!$      ! Arguments
+!!$      class(amg_s_ainv_solver_type), intent(inout) :: sv
+!!$      integer(psb_ipk_), intent(in)                :: what
+!!$      real(psb_spk_), intent(in)                   :: val
+!!$      integer(psb_ipk_), intent(out)               :: info
+!!$    end subroutine amg_s_ainv_solver_setr
+!!$  end interface
 
   interface
     subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse)

amgprec/amg_s_invk_solver.f90

@@ -51,8 +51,6 @@ module amg_s_invk_solver
     procedure, pass(sv) :: clone   => amg_s_invk_solver_clone
     procedure, pass(sv) :: build   => amg_s_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_s_invk_solver_cseti
-    procedure, pass(sv) :: seti    => amg_s_invk_solver_seti
-    generic, public     :: set     => seti
     procedure, pass(sv) :: descr   => amg_s_invk_solver_descr
     procedure, pass(sv) :: default => s_invk_solver_default
   end type amg_s_invk_solver_type
@@ -136,18 +134,6 @@ module amg_s_invk_solver
     end subroutine amg_s_invk_solver_descr
   end interface
 
-  interface
-    subroutine amg_s_invk_solver_seti(sv,what,val,info)
-      import :: amg_s_invk_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_s_invk_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      integer(psb_ipk_), intent(in)                :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_s_invk_solver_seti
-  end interface
-
 contains
 
   subroutine s_invk_solver_default(sv)

amgprec/amg_s_invt_solver.f90

@@ -52,9 +52,6 @@ module amg_s_invt_solver
     procedure, pass(sv) :: build   => amg_s_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_s_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_s_invt_solver_csetr
-    procedure, pass(sv) :: seti    => amg_s_invt_solver_seti
-    procedure, pass(sv) :: setr    => amg_s_invt_solver_setr
-    generic, public     :: set     => seti, setr
     procedure, pass(sv) :: descr   => amg_s_invt_solver_descr
     procedure, pass(sv) :: default => s_invt_solver_default
   end type amg_s_invt_solver_type
@@ -148,30 +145,6 @@ module amg_s_invt_solver
     end subroutine amg_s_invt_solver_descr
   end interface
 
-  interface
-    subroutine amg_s_invt_solver_setr(sv,what,val,info)
-      import :: amg_s_invt_solver_type, psb_spk_, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_s_invt_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      real(psb_spk_), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_s_invt_solver_setr
-  end interface
-
-  interface
-    subroutine amg_s_invt_solver_seti(sv,what,val,info)
-      import :: amg_s_invt_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_s_invt_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      integer(psb_ipk_), intent(in)                :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine
-  end interface
-
 contains
 
   subroutine s_invt_solver_default(sv)

amgprec/amg_s_onelev_mod.f90

@@ -152,6 +152,15 @@ module amg_s_onelev_mod
   end type amg_smlprec_wrk_type
   private :: s_wrk_alloc, s_wrk_free, &
        & s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv, s_wrk_sizeof    
+
+  type amg_s_remap_data_type
+    type(psb_sspmat_type)          :: ac_pre_remap
+    type(psb_desc_type)            :: desc_ac_pre_remap
+    integer(psb_ipk_)              :: idest
+    integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
+  contains
+    procedure, pass(rmp) :: clone   => s_remap_data_clone
+  end type amg_s_remap_data_type
   
   type amg_s_onelev_type
     class(amg_s_base_smoother_type), allocatable   :: sm, sm2a
@@ -166,7 +175,8 @@ module amg_s_onelev_mod
     type(psb_sspmat_type), pointer   :: base_a    => null() 
     type(psb_desc_type), pointer     :: base_desc => null() 
     type(psb_lsspmat_type)           :: tprol
-    type(psb_slinmap_type)           :: map
+    type(psb_slinmap_type)           :: linmap
+    type(amg_s_remap_data_type)      :: remap_data
     real(psb_spk_)                     :: szratio
   contains
     procedure, pass(lv) :: bld_tprol   => s_base_onelev_bld_tprol
@@ -196,6 +206,13 @@ module amg_s_onelev_mod
     procedure, nopass   :: stringval => amg_stringval
     procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc
     
+    
+    procedure, pass(lv) :: map_rstr_a => amg_s_base_onelev_map_rstr_a
+    procedure, pass(lv) :: map_prol_a => amg_s_base_onelev_map_prol_a
+    procedure, pass(lv) :: map_rstr_v => amg_s_base_onelev_map_rstr_v
+    procedure, pass(lv) :: map_prol_v => amg_s_base_onelev_map_prol_v
+    generic, public     :: map_rstr => map_rstr_a, map_rstr_v
+    generic, public     :: map_prol => map_prol_a, map_prol_v
   end type amg_s_onelev_type
 
   type amg_s_onelev_node
@@ -239,16 +256,17 @@ module amg_s_onelev_mod
   end interface
 
   interface 
-    subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout)
+    subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
            & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
       ! Arguments
-      class(amg_s_onelev_type), intent(in) :: lv
-      integer(psb_ipk_), intent(in)                 :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)                :: info
-      integer(psb_ipk_), intent(in), optional       :: iout
+      class(amg_s_onelev_type), intent(in)    :: lv
+      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
+      integer(psb_ipk_), intent(out)          :: info
+      integer(psb_ipk_), intent(in), optional :: iout
+      integer(psb_ipk_), intent(in), optional :: verbosity
     end subroutine amg_s_base_onelev_descr
   end interface
 
@@ -394,6 +412,53 @@ interface
       logical, optional, intent(in)    :: ac, rp, smoother, solver, tprol, global_num
     end subroutine amg_s_base_onelev_dump
   end interface
+
+  interface
+    subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
+      import
+      implicit none
+      class(amg_s_onelev_type), target, intent(inout) :: lv
+      real(psb_spk_), intent(in)     :: alpha, beta
+      real(psb_spk_), intent(inout)   :: u(:)
+      real(psb_spk_), intent(out)     :: v(:)
+      integer(psb_ipk_), intent(out) :: info
+      real(psb_spk_), optional       :: work(:)
+    end subroutine amg_s_base_onelev_map_rstr_a
+    subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
+      import
+      implicit none
+      class(amg_s_onelev_type), target, intent(inout) :: lv
+      real(psb_spk_), intent(in)           :: alpha, beta
+      type(psb_s_vect_type), intent(inout) :: vect_u, vect_v
+      integer(psb_ipk_), intent(out)       :: info
+      real(psb_spk_), optional          :: work(:)
+      type(psb_s_vect_type), optional, target, intent(inout)  :: vtx,vty
+    end subroutine amg_s_base_onelev_map_rstr_v
+  end interface
+
+  interface 
+    subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
+      import
+      implicit none
+      class(amg_s_onelev_type), target, intent(inout) :: lv
+      real(psb_spk_), intent(in)     :: alpha, beta
+      real(psb_spk_), intent(inout)   :: u(:)
+      real(psb_spk_), intent(out)     :: v(:)
+      integer(psb_ipk_), intent(out) :: info
+      real(psb_spk_), optional          :: work(:)
+
+    end subroutine amg_s_base_onelev_map_prol_a
+    subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
+      import
+      implicit none
+      class(amg_s_onelev_type), target, intent(inout) :: lv
+      real(psb_spk_), intent(in)           :: alpha, beta
+      type(psb_s_vect_type), intent(inout) :: vect_u, vect_v
+      integer(psb_ipk_), intent(out)       :: info
+      real(psb_spk_), optional          :: work(:)
+      type(psb_s_vect_type), optional, target, intent(inout)  :: vtx,vty
+    end subroutine amg_s_base_onelev_map_prol_v
+  end interface
   
 contains
   !
@@ -423,7 +488,7 @@ contains
     val = val + lv%desc_ac%sizeof()
     val = val + lv%ac%sizeof()
     val = val + lv%tprol%sizeof()
-    val = val + lv%map%sizeof() 
+    val = val + lv%linmap%sizeof() 
     if (allocated(lv%sm))   val = val + lv%sm%sizeof()
     if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
     if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -553,7 +618,8 @@ contains
     if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
     if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
     if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
-    if (info == psb_success_) call lv%map%clone(lvout%map,info)
+    if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
+    if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
     lvout%base_a    => lv%base_a
     lvout%base_desc => lv%base_desc
     
@@ -584,7 +650,7 @@ contains
     if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info) 
     if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info) 
     if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info) 
-    if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info) 
+    if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info) 
     b%base_a    => lv%base_a
     b%base_desc => lv%base_desc
     
@@ -639,7 +705,17 @@ contains
     info = psb_success_
     nwv = lv%get_wrksz()
     if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
-    if (info == 0) call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
+    if (info == 0) then
+      if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
+        !
+        !  Need to fix this, we need two different allocations
+        !
+        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
+             & desc2=lv%remap_data%desc_ac_pre_remap)      
+      else
+        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
+      end if
+    end if
     
   end subroutine s_base_onelev_allocate_wrk
 
@@ -659,7 +735,7 @@ contains
     end if
   end subroutine s_base_onelev_free_wrk
   
-  subroutine s_wrk_alloc(wk,nwv,desc,info,vmold)
+  subroutine s_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
     use psb_base_mod
     
     Implicit None
@@ -670,25 +746,67 @@ contains
     type(psb_desc_type), intent(in)                   :: desc
     integer(psb_ipk_), intent(out)                    :: info 
     class(psb_s_base_vect_type), intent(in), optional  :: vmold
+    type(psb_desc_type), intent(in), optional          :: desc2
     !
     integer(psb_ipk_) :: i
 
     info = psb_success_
     call wk%free(info)
-    call psb_geasb(wk%vx2l,desc,info,&
-         & scratch=.true.,mold=vmold)
-    call psb_geasb(wk%vy2l,desc,info,&
-         & scratch=.true.,mold=vmold)
-    call psb_geasb(wk%vtx,desc,info,&
-         & scratch=.true.,mold=vmold)
-    call psb_geasb(wk%vty,desc,info,&
-         & scratch=.true.,mold=vmold)
-    allocate(wk%wv(nwv),stat=info)
-    do i=1,nwv
-      call psb_geasb(wk%wv(i),desc,info,&
+    if  (present(desc2)) then
+!!$      write(0,*) 'Check on wrk_alloc 2',&
+!!$           & desc2%get_local_rows(), desc%get_local_rows(),&
+!!$           & desc2%get_local_cols(),desc%get_local_cols()
+!!$      flush(0)
+      if (desc2%get_local_cols()>desc%get_local_cols()) then
+        call psb_geasb(wk%vx2l,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vy2l,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vtx,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vty,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        allocate(wk%wv(nwv),stat=info)
+        do i=1,nwv
+          call psb_geasb(wk%wv(i),desc2,info,&
+               & scratch=.true.,mold=vmold)
+        end do
+      else
+!!$        write(0,*) 'Check on wrk_alloc 1.5 ',&
+!!$             & desc%get_local_rows(),&
+!!$             & desc%get_local_cols()
+        call psb_geasb(wk%vx2l,desc,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vy2l,desc,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vtx,desc,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vty,desc,info,&
+             & scratch=.true.,mold=vmold)
+        allocate(wk%wv(nwv),stat=info)
+        do i=1,nwv
+          call psb_geasb(wk%wv(i),desc,info,&
+               & scratch=.true.,mold=vmold)
+        end do
+      end if
+    else
+!!$      write(0,*) 'Check on wrk_alloc 1 ',&
+!!$           & desc%get_local_rows(),&
+!!$           & desc%get_local_cols()
+      call psb_geasb(wk%vx2l,desc,info,&
            & scratch=.true.,mold=vmold)
-    end do
-    
+      call psb_geasb(wk%vy2l,desc,info,&
+           & scratch=.true.,mold=vmold)
+      call psb_geasb(wk%vtx,desc,info,&
+           & scratch=.true.,mold=vmold)
+      call psb_geasb(wk%vty,desc,info,&
+           & scratch=.true.,mold=vmold)
+      allocate(wk%wv(nwv),stat=info)
+      do i=1,nwv
+        call psb_geasb(wk%wv(i),desc,info,&
+             & scratch=.true.,mold=vmold)
+      end do
+    end if
   end subroutine s_wrk_alloc
     
   subroutine s_wrk_free(wk,info)
@@ -821,4 +939,24 @@ contains
     end if
   end function s_wrk_sizeof
  
+  subroutine s_remap_data_clone(rmp, remap_out, info)
+    use psb_base_mod
+    implicit none 
+    ! Arguments
+    class(amg_s_remap_data_type), target, intent(inout) :: rmp
+    class(amg_s_remap_data_type), target, intent(inout) :: remap_out
+    integer(psb_ipk_), intent(out)                    :: info 
+    !
+    integer(psb_ipk_) :: i
+
+    info = psb_success_
+
+    call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
+    if (info == psb_success_) &
+         & call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
+    remap_out%idest = rmp%idest
+    call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
+    call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)    
+  end subroutine s_remap_data_clone
+  
 end module amg_s_onelev_mod

amgprec/amg_s_prec_mod.f90

@@ -55,12 +55,7 @@ module amg_s_prec_mod
   use amg_s_ainv_solver
   use amg_s_invk_solver
   use amg_s_invt_solver
-
-  interface amg_precset
-    module procedure amg_s_iprecsetsm, amg_s_iprecsetsv, &
-         & amg_s_cprecseti, amg_s_cprecsetc, amg_s_cprecsetr, &
-         & amg_s_iprecsetag
-  end interface amg_precset
+  use amg_s_rkr_solver
 
   interface amg_extprol_bld
     subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
@@ -82,61 +77,4 @@ module amg_s_prec_mod
     end subroutine amg_s_extprol_bld
   end interface amg_extprol_bld
 
-contains
-
-  subroutine amg_s_iprecsetsm(p,val,info,pos)
-    type(amg_sprec_type), intent(inout)    :: p
-    class(amg_s_base_smoother_type), intent(in)   :: val
-    integer(psb_ipk_), intent(out)           :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(val,info,pos=pos)
-  end subroutine amg_s_iprecsetsm
-
-  subroutine amg_s_iprecsetsv(p,val,info,pos)
-    type(amg_sprec_type), intent(inout)    :: p
-    class(amg_s_base_solver_type), intent(in)   :: val
-    integer(psb_ipk_), intent(out)                :: info
-    character(len=*), optional, intent(in)      :: pos
-    call p%set(val,info, pos=pos)
-  end subroutine amg_s_iprecsetsv
-
-  subroutine amg_s_iprecsetag(p,val,info,pos)
-    type(amg_sprec_type), intent(inout)    :: p
-    class(amg_s_base_aggregator_type), intent(in)   :: val
-    integer(psb_ipk_), intent(out)                :: info
-    character(len=*), optional, intent(in)      :: pos
-    call p%set(val,info, pos=pos)
-  end subroutine amg_s_iprecsetag
-
-  subroutine amg_s_cprecseti(p,what,val,info,pos)
-    type(amg_sprec_type), intent(inout)   :: p
-    character(len=*), intent(in)            :: what
-    integer(psb_ipk_), intent(in)           :: val
-    integer(psb_ipk_), intent(out)          :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(what,val,info,pos=pos)
-  end subroutine amg_s_cprecseti
-
-  subroutine amg_s_cprecsetr(p,what,val,info,pos)
-    type(amg_sprec_type), intent(inout)   :: p
-    character(len=*), intent(in)            :: what
-    real(psb_spk_), intent(in)             :: val
-    integer(psb_ipk_), intent(out)          :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(what,val,info,pos=pos)
-  end subroutine amg_s_cprecsetr
-
-  subroutine amg_s_cprecsetc(p,what,val,info,pos)
-    type(amg_sprec_type), intent(inout)   :: p
-    character(len=*), intent(in)            :: what
-    character(len=*), intent(in)            :: val
-    integer(psb_ipk_), intent(out)          :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(what,val,info,pos=pos)
-  end subroutine amg_s_cprecsetc
-
 end module amg_s_prec_mod

amgprec/amg_s_prec_type.f90

@@ -155,13 +155,14 @@ module amg_s_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_sfile_prec_descr(prec,iout,root)
+    subroutine amg_sfile_prec_descr(prec,iout,root,verbosity)
       import :: amg_sprec_type, psb_ipk_
       implicit none
       ! Arguments
       class(amg_sprec_type), intent(in)      :: prec
       integer(psb_ipk_), intent(in), optional :: iout
       integer(psb_ipk_), intent(in), optional :: root
+      integer(psb_ipk_), intent(in), optional :: verbosity
     end subroutine amg_sfile_prec_descr
   end interface
 
@@ -424,11 +425,22 @@ contains
     end if
   end function amg_s_get_nzeros
 
-  function amg_sprec_sizeof(prec) result(val)
+  function amg_sprec_sizeof(prec, global) result(val)
     implicit none
     class(amg_sprec_type), intent(in) :: prec
-    integer(psb_epk_) :: val
+    logical, intent(in), optional :: global
+    integer(psb_epk_) :: val    
     integer(psb_ipk_)        :: i
+    type(psb_ctxt_type) :: ctxt
+    
+    logical :: global_
+
+    if (present(global)) then
+      global_ = global
+    else
+      global_ = .false.
+    end if
+    
     val = 0
     val = val + psb_sizeof_ip
     if (allocated(prec%precv)) then
@@ -436,6 +448,11 @@ contains
         val = val + prec%precv(i)%sizeof()
       end do
     end if
+    if (global_) then
+      ctxt = prec%ctxt
+      call psb_sum(ctxt,val)
+    end if
+
   end function amg_sprec_sizeof
 
   !
@@ -738,16 +755,15 @@ contains
     character(len=*), intent(in), optional  :: prefix, head
     logical, optional, intent(in)    :: smoother, solver,ac, rp, tprol, global_num
     integer(psb_ipk_)   :: i, j, il1, iln, lev
-    type(psb_ctxt_type) :: icontxt
+    type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_)   :: iam, np, iproc_
     character(len=80)   :: prefix_
     character(len=120)  :: fname ! len should be at least 20 more than
     !  len of prefix_
 
     info = 0
-    icontxt = prec%ctxt
-    call psb_info(icontxt,iam,np)
-
+    ctxt = prec%ctxt
+    call psb_info(ctxt,iam,np)
     iln = size(prec%precv)
     if (present(istart)) then
       il1 = max(1,istart)
@@ -812,13 +828,13 @@ contains
     integer(psb_ipk_), intent(out)             :: info
     ! Local vars
     integer(psb_ipk_)   :: i, j, ln, lev
-    type(psb_ctxt_type) :: icontxt
+    type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_)   :: iam, np
 
     info = psb_success_
     select type(pout => precout)
     class is (amg_sprec_type)
-      pout%ctxt         = prec%ctxt
+      pout%ctxt          = prec%ctxt
       pout%ag_data       = prec%ag_data
       pout%outer_sweeps  = prec%outer_sweeps
       if (allocated(prec%precv)) then
@@ -834,8 +850,8 @@ contains
           if (info == psb_success_) then
             pout%precv(lev)%base_a       => pout%precv(lev)%ac
             pout%precv(lev)%base_desc    => pout%precv(lev)%desc_ac
-            pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
-            pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
+            pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
+            pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
           end if
         end do
       end if
@@ -875,8 +891,8 @@ contains
       do i=2, size(b%precv)
         b%precv(i)%base_a    => b%precv(i)%ac
         b%precv(i)%base_desc => b%precv(i)%desc_ac
-        b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
-        b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
+        b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
+        b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
       end do
 
     else

amgprec/amg_z_ainv_solver.F90

@@ -58,10 +58,9 @@ module amg_z_ainv_solver
     procedure, pass(sv) :: cseti   => amg_z_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_z_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_z_ainv_solver_csetr
-    procedure, pass(sv) :: seti    => amg_z_ainv_solver_seti
-    procedure, pass(sv) :: setc    => amg_z_ainv_solver_setc
-    procedure, pass(sv) :: setr    => amg_z_ainv_solver_setr
-    generic, public :: set => seti, setr, setc
+!!$    procedure, pass(sv) :: seti    => amg_z_ainv_solver_seti
+!!$    procedure, pass(sv) :: setc    => amg_z_ainv_solver_setc
+!!$    procedure, pass(sv) :: setr    => amg_z_ainv_solver_setr
     procedure, pass(sv) :: descr   => amg_z_ainv_solver_descr
     procedure, pass(sv) :: default => z_ainv_solver_default
     procedure, nopass   :: stringval  => z_ainv_stringval
@@ -159,41 +158,41 @@ module amg_z_ainv_solver
     end subroutine amg_z_ainv_solver_csetr
   end interface
 
-  interface
-    subroutine amg_z_ainv_solver_setc(sv,what,val,info)
-      import :: amg_z_ainv_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_z_ainv_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      character(len=*), intent(in)                 :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_z_ainv_solver_setc
-  end interface
-
-  interface
-    subroutine amg_z_ainv_solver_seti(sv,what,val,info)
-      import :: amg_z_ainv_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_z_ainv_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      integer(psb_ipk_), intent(in)                :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_z_ainv_solver_seti
-  end interface
-
-  interface
-    subroutine amg_z_ainv_solver_setr(sv,what,val,info)
-      import :: amg_z_ainv_solver_type, psb_ipk_, psb_dpk_
-      Implicit none
-      ! Arguments
-      class(amg_z_ainv_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      real(psb_dpk_), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_z_ainv_solver_setr
-  end interface
+!!$  interface
+!!$    subroutine amg_z_ainv_solver_setc(sv,what,val,info)
+!!$      import :: amg_z_ainv_solver_type, psb_ipk_
+!!$      Implicit none
+!!$      ! Arguments
+!!$      class(amg_z_ainv_solver_type), intent(inout) :: sv
+!!$      integer(psb_ipk_), intent(in)                :: what
+!!$      character(len=*), intent(in)                 :: val
+!!$      integer(psb_ipk_), intent(out)               :: info
+!!$    end subroutine amg_z_ainv_solver_setc
+!!$  end interface
+!!$
+!!$  interface
+!!$    subroutine amg_z_ainv_solver_seti(sv,what,val,info)
+!!$      import :: amg_z_ainv_solver_type, psb_ipk_
+!!$      Implicit none
+!!$      ! Arguments
+!!$      class(amg_z_ainv_solver_type), intent(inout) :: sv
+!!$      integer(psb_ipk_), intent(in)                :: what
+!!$      integer(psb_ipk_), intent(in)                :: val
+!!$      integer(psb_ipk_), intent(out)               :: info
+!!$    end subroutine amg_z_ainv_solver_seti
+!!$  end interface
+!!$
+!!$  interface
+!!$    subroutine amg_z_ainv_solver_setr(sv,what,val,info)
+!!$      import :: amg_z_ainv_solver_type, psb_ipk_, psb_dpk_
+!!$      Implicit none
+!!$      ! Arguments
+!!$      class(amg_z_ainv_solver_type), intent(inout) :: sv
+!!$      integer(psb_ipk_), intent(in)                :: what
+!!$      real(psb_dpk_), intent(in)                   :: val
+!!$      integer(psb_ipk_), intent(out)               :: info
+!!$    end subroutine amg_z_ainv_solver_setr
+!!$  end interface
 
   interface
     subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse)

amgprec/amg_z_invk_solver.f90

@@ -51,8 +51,6 @@ module amg_z_invk_solver
     procedure, pass(sv) :: clone   => amg_z_invk_solver_clone
     procedure, pass(sv) :: build   => amg_z_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_z_invk_solver_cseti
-    procedure, pass(sv) :: seti    => amg_z_invk_solver_seti
-    generic, public     :: set     => seti
     procedure, pass(sv) :: descr   => amg_z_invk_solver_descr
     procedure, pass(sv) :: default => z_invk_solver_default
   end type amg_z_invk_solver_type
@@ -136,18 +134,6 @@ module amg_z_invk_solver
     end subroutine amg_z_invk_solver_descr
   end interface
 
-  interface
-    subroutine amg_z_invk_solver_seti(sv,what,val,info)
-      import :: amg_z_invk_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_z_invk_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      integer(psb_ipk_), intent(in)                :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_z_invk_solver_seti
-  end interface
-
 contains
 
   subroutine z_invk_solver_default(sv)

amgprec/amg_z_invt_solver.f90

@@ -52,9 +52,6 @@ module amg_z_invt_solver
     procedure, pass(sv) :: build   => amg_z_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_z_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_z_invt_solver_csetr
-    procedure, pass(sv) :: seti    => amg_z_invt_solver_seti
-    procedure, pass(sv) :: setr    => amg_z_invt_solver_setr
-    generic, public     :: set     => seti, setr
     procedure, pass(sv) :: descr   => amg_z_invt_solver_descr
     procedure, pass(sv) :: default => z_invt_solver_default
   end type amg_z_invt_solver_type
@@ -148,30 +145,6 @@ module amg_z_invt_solver
     end subroutine amg_z_invt_solver_descr
   end interface
 
-  interface
-    subroutine amg_z_invt_solver_setr(sv,what,val,info)
-      import :: amg_z_invt_solver_type, psb_dpk_, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_z_invt_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      real(psb_dpk_), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_z_invt_solver_setr
-  end interface
-
-  interface
-    subroutine amg_z_invt_solver_seti(sv,what,val,info)
-      import :: amg_z_invt_solver_type, psb_ipk_
-      Implicit none
-      ! Arguments
-      class(amg_z_invt_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(in)                :: what
-      integer(psb_ipk_), intent(in)                :: val
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine
-  end interface
-
 contains
 
   subroutine z_invt_solver_default(sv)

amgprec/amg_z_onelev_mod.f90

@@ -152,6 +152,15 @@ module amg_z_onelev_mod
   end type amg_zmlprec_wrk_type
   private :: z_wrk_alloc, z_wrk_free, &
        & z_wrk_clone, z_wrk_move_alloc, z_wrk_cnv, z_wrk_sizeof    
+
+  type amg_z_remap_data_type
+    type(psb_zspmat_type)          :: ac_pre_remap
+    type(psb_desc_type)            :: desc_ac_pre_remap
+    integer(psb_ipk_)              :: idest
+    integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
+  contains
+    procedure, pass(rmp) :: clone   => z_remap_data_clone
+  end type amg_z_remap_data_type
   
   type amg_z_onelev_type
     class(amg_z_base_smoother_type), allocatable   :: sm, sm2a
@@ -166,7 +175,8 @@ module amg_z_onelev_mod
     type(psb_zspmat_type), pointer   :: base_a    => null() 
     type(psb_desc_type), pointer     :: base_desc => null() 
     type(psb_lzspmat_type)           :: tprol
-    type(psb_zlinmap_type)           :: map
+    type(psb_zlinmap_type)           :: linmap
+    type(amg_z_remap_data_type)      :: remap_data
     real(psb_dpk_)                     :: szratio
   contains
     procedure, pass(lv) :: bld_tprol   => z_base_onelev_bld_tprol
@@ -196,6 +206,13 @@ module amg_z_onelev_mod
     procedure, nopass   :: stringval => amg_stringval
     procedure, pass(lv) :: move_alloc => z_base_onelev_move_alloc
     
+    
+    procedure, pass(lv) :: map_rstr_a => amg_z_base_onelev_map_rstr_a
+    procedure, pass(lv) :: map_prol_a => amg_z_base_onelev_map_prol_a
+    procedure, pass(lv) :: map_rstr_v => amg_z_base_onelev_map_rstr_v
+    procedure, pass(lv) :: map_prol_v => amg_z_base_onelev_map_prol_v
+    generic, public     :: map_rstr => map_rstr_a, map_rstr_v
+    generic, public     :: map_prol => map_prol_a, map_prol_v
   end type amg_z_onelev_type
 
   type amg_z_onelev_node
@@ -239,16 +256,17 @@ module amg_z_onelev_mod
   end interface
 
   interface 
-    subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout)
+    subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
       import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
            & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
            & psb_ipk_, psb_epk_, psb_desc_type
       Implicit None
       ! Arguments
-      class(amg_z_onelev_type), intent(in) :: lv
-      integer(psb_ipk_), intent(in)                 :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)                :: info
-      integer(psb_ipk_), intent(in), optional       :: iout
+      class(amg_z_onelev_type), intent(in)    :: lv
+      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
+      integer(psb_ipk_), intent(out)          :: info
+      integer(psb_ipk_), intent(in), optional :: iout
+      integer(psb_ipk_), intent(in), optional :: verbosity
     end subroutine amg_z_base_onelev_descr
   end interface
 
@@ -394,6 +412,53 @@ interface
       logical, optional, intent(in)    :: ac, rp, smoother, solver, tprol, global_num
     end subroutine amg_z_base_onelev_dump
   end interface
+
+  interface
+    subroutine amg_z_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
+      import
+      implicit none
+      class(amg_z_onelev_type), target, intent(inout) :: lv
+      complex(psb_dpk_), intent(in)     :: alpha, beta
+      complex(psb_dpk_), intent(inout)   :: u(:)
+      complex(psb_dpk_), intent(out)     :: v(:)
+      integer(psb_ipk_), intent(out) :: info
+      complex(psb_dpk_), optional       :: work(:)
+    end subroutine amg_z_base_onelev_map_rstr_a
+    subroutine amg_z_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
+      import
+      implicit none
+      class(amg_z_onelev_type), target, intent(inout) :: lv
+      complex(psb_dpk_), intent(in)           :: alpha, beta
+      type(psb_z_vect_type), intent(inout) :: vect_u, vect_v
+      integer(psb_ipk_), intent(out)       :: info
+      complex(psb_dpk_), optional          :: work(:)
+      type(psb_z_vect_type), optional, target, intent(inout)  :: vtx,vty
+    end subroutine amg_z_base_onelev_map_rstr_v
+  end interface
+
+  interface 
+    subroutine amg_z_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
+      import
+      implicit none
+      class(amg_z_onelev_type), target, intent(inout) :: lv
+      complex(psb_dpk_), intent(in)     :: alpha, beta
+      complex(psb_dpk_), intent(inout)   :: u(:)
+      complex(psb_dpk_), intent(out)     :: v(:)
+      integer(psb_ipk_), intent(out) :: info
+      complex(psb_dpk_), optional          :: work(:)
+
+    end subroutine amg_z_base_onelev_map_prol_a
+    subroutine amg_z_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
+      import
+      implicit none
+      class(amg_z_onelev_type), target, intent(inout) :: lv
+      complex(psb_dpk_), intent(in)           :: alpha, beta
+      type(psb_z_vect_type), intent(inout) :: vect_u, vect_v
+      integer(psb_ipk_), intent(out)       :: info
+      complex(psb_dpk_), optional          :: work(:)
+      type(psb_z_vect_type), optional, target, intent(inout)  :: vtx,vty
+    end subroutine amg_z_base_onelev_map_prol_v
+  end interface
   
 contains
   !
@@ -423,7 +488,7 @@ contains
     val = val + lv%desc_ac%sizeof()
     val = val + lv%ac%sizeof()
     val = val + lv%tprol%sizeof()
-    val = val + lv%map%sizeof() 
+    val = val + lv%linmap%sizeof() 
     if (allocated(lv%sm))   val = val + lv%sm%sizeof()
     if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
     if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -553,7 +618,8 @@ contains
     if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
     if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
     if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
-    if (info == psb_success_) call lv%map%clone(lvout%map,info)
+    if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
+    if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
     lvout%base_a    => lv%base_a
     lvout%base_desc => lv%base_desc
     
@@ -584,7 +650,7 @@ contains
     if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info) 
     if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info) 
     if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info) 
-    if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info) 
+    if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info) 
     b%base_a    => lv%base_a
     b%base_desc => lv%base_desc
     
@@ -639,7 +705,17 @@ contains
     info = psb_success_
     nwv = lv%get_wrksz()
     if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
-    if (info == 0) call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
+    if (info == 0) then
+      if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
+        !
+        !  Need to fix this, we need two different allocations
+        !
+        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
+             & desc2=lv%remap_data%desc_ac_pre_remap)      
+      else
+        call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
+      end if
+    end if
     
   end subroutine z_base_onelev_allocate_wrk
 
@@ -659,7 +735,7 @@ contains
     end if
   end subroutine z_base_onelev_free_wrk
   
-  subroutine z_wrk_alloc(wk,nwv,desc,info,vmold)
+  subroutine z_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
     use psb_base_mod
     
     Implicit None
@@ -670,25 +746,67 @@ contains
     type(psb_desc_type), intent(in)                   :: desc
     integer(psb_ipk_), intent(out)                    :: info 
     class(psb_z_base_vect_type), intent(in), optional  :: vmold
+    type(psb_desc_type), intent(in), optional          :: desc2
     !
     integer(psb_ipk_) :: i
 
     info = psb_success_
     call wk%free(info)
-    call psb_geasb(wk%vx2l,desc,info,&
-         & scratch=.true.,mold=vmold)
-    call psb_geasb(wk%vy2l,desc,info,&
-         & scratch=.true.,mold=vmold)
-    call psb_geasb(wk%vtx,desc,info,&
-         & scratch=.true.,mold=vmold)
-    call psb_geasb(wk%vty,desc,info,&
-         & scratch=.true.,mold=vmold)
-    allocate(wk%wv(nwv),stat=info)
-    do i=1,nwv
-      call psb_geasb(wk%wv(i),desc,info,&
+    if  (present(desc2)) then
+!!$      write(0,*) 'Check on wrk_alloc 2',&
+!!$           & desc2%get_local_rows(), desc%get_local_rows(),&
+!!$           & desc2%get_local_cols(),desc%get_local_cols()
+!!$      flush(0)
+      if (desc2%get_local_cols()>desc%get_local_cols()) then
+        call psb_geasb(wk%vx2l,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vy2l,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vtx,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vty,desc2,info,&
+             & scratch=.true.,mold=vmold)
+        allocate(wk%wv(nwv),stat=info)
+        do i=1,nwv
+          call psb_geasb(wk%wv(i),desc2,info,&
+               & scratch=.true.,mold=vmold)
+        end do
+      else
+!!$        write(0,*) 'Check on wrk_alloc 1.5 ',&
+!!$             & desc%get_local_rows(),&
+!!$             & desc%get_local_cols()
+        call psb_geasb(wk%vx2l,desc,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vy2l,desc,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vtx,desc,info,&
+             & scratch=.true.,mold=vmold)
+        call psb_geasb(wk%vty,desc,info,&
+             & scratch=.true.,mold=vmold)
+        allocate(wk%wv(nwv),stat=info)
+        do i=1,nwv
+          call psb_geasb(wk%wv(i),desc,info,&
+               & scratch=.true.,mold=vmold)
+        end do
+      end if
+    else
+!!$      write(0,*) 'Check on wrk_alloc 1 ',&
+!!$           & desc%get_local_rows(),&
+!!$           & desc%get_local_cols()
+      call psb_geasb(wk%vx2l,desc,info,&
            & scratch=.true.,mold=vmold)
-    end do
-    
+      call psb_geasb(wk%vy2l,desc,info,&
+           & scratch=.true.,mold=vmold)
+      call psb_geasb(wk%vtx,desc,info,&
+           & scratch=.true.,mold=vmold)
+      call psb_geasb(wk%vty,desc,info,&
+           & scratch=.true.,mold=vmold)
+      allocate(wk%wv(nwv),stat=info)
+      do i=1,nwv
+        call psb_geasb(wk%wv(i),desc,info,&
+             & scratch=.true.,mold=vmold)
+      end do
+    end if
   end subroutine z_wrk_alloc
     
   subroutine z_wrk_free(wk,info)
@@ -821,4 +939,24 @@ contains
     end if
   end function z_wrk_sizeof
  
+  subroutine z_remap_data_clone(rmp, remap_out, info)
+    use psb_base_mod
+    implicit none 
+    ! Arguments
+    class(amg_z_remap_data_type), target, intent(inout) :: rmp
+    class(amg_z_remap_data_type), target, intent(inout) :: remap_out
+    integer(psb_ipk_), intent(out)                    :: info 
+    !
+    integer(psb_ipk_) :: i
+
+    info = psb_success_
+
+    call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
+    if (info == psb_success_) &
+         & call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
+    remap_out%idest = rmp%idest
+    call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
+    call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)    
+  end subroutine z_remap_data_clone
+  
 end module amg_z_onelev_mod

amgprec/amg_z_prec_mod.f90

@@ -55,12 +55,7 @@ module amg_z_prec_mod
   use amg_z_ainv_solver
   use amg_z_invk_solver
   use amg_z_invt_solver
-
-  interface amg_precset
-    module procedure amg_z_iprecsetsm, amg_z_iprecsetsv, &
-         & amg_z_cprecseti, amg_z_cprecsetc, amg_z_cprecsetr, &
-         & amg_z_iprecsetag
-  end interface amg_precset
+  use amg_z_rkr_solver
 
   interface amg_extprol_bld
     subroutine amg_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
@@ -82,61 +77,4 @@ module amg_z_prec_mod
     end subroutine amg_z_extprol_bld
   end interface amg_extprol_bld
 
-contains
-
-  subroutine amg_z_iprecsetsm(p,val,info,pos)
-    type(amg_zprec_type), intent(inout)    :: p
-    class(amg_z_base_smoother_type), intent(in)   :: val
-    integer(psb_ipk_), intent(out)           :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(val,info,pos=pos)
-  end subroutine amg_z_iprecsetsm
-
-  subroutine amg_z_iprecsetsv(p,val,info,pos)
-    type(amg_zprec_type), intent(inout)    :: p
-    class(amg_z_base_solver_type), intent(in)   :: val
-    integer(psb_ipk_), intent(out)                :: info
-    character(len=*), optional, intent(in)      :: pos
-    call p%set(val,info, pos=pos)
-  end subroutine amg_z_iprecsetsv
-
-  subroutine amg_z_iprecsetag(p,val,info,pos)
-    type(amg_zprec_type), intent(inout)    :: p
-    class(amg_z_base_aggregator_type), intent(in)   :: val
-    integer(psb_ipk_), intent(out)                :: info
-    character(len=*), optional, intent(in)      :: pos
-    call p%set(val,info, pos=pos)
-  end subroutine amg_z_iprecsetag
-
-  subroutine amg_z_cprecseti(p,what,val,info,pos)
-    type(amg_zprec_type), intent(inout)   :: p
-    character(len=*), intent(in)            :: what
-    integer(psb_ipk_), intent(in)           :: val
-    integer(psb_ipk_), intent(out)          :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(what,val,info,pos=pos)
-  end subroutine amg_z_cprecseti
-
-  subroutine amg_z_cprecsetr(p,what,val,info,pos)
-    type(amg_zprec_type), intent(inout)   :: p
-    character(len=*), intent(in)            :: what
-    real(psb_dpk_), intent(in)             :: val
-    integer(psb_ipk_), intent(out)          :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(what,val,info,pos=pos)
-  end subroutine amg_z_cprecsetr
-
-  subroutine amg_z_cprecsetc(p,what,val,info,pos)
-    type(amg_zprec_type), intent(inout)   :: p
-    character(len=*), intent(in)            :: what
-    character(len=*), intent(in)            :: val
-    integer(psb_ipk_), intent(out)          :: info
-    character(len=*), optional, intent(in)      :: pos
-
-    call p%set(what,val,info,pos=pos)
-  end subroutine amg_z_cprecsetc
-
 end module amg_z_prec_mod

amgprec/amg_z_prec_type.f90

@@ -155,13 +155,14 @@ module amg_z_prec_type
 
 
   interface amg_precdescr
-    subroutine amg_zfile_prec_descr(prec,iout,root)
+    subroutine amg_zfile_prec_descr(prec,iout,root,verbosity)
       import :: amg_zprec_type, psb_ipk_
       implicit none
       ! Arguments
       class(amg_zprec_type), intent(in)      :: prec
       integer(psb_ipk_), intent(in), optional :: iout
       integer(psb_ipk_), intent(in), optional :: root
+      integer(psb_ipk_), intent(in), optional :: verbosity
     end subroutine amg_zfile_prec_descr
   end interface
 
@@ -424,11 +425,22 @@ contains
     end if
   end function amg_z_get_nzeros
 
-  function amg_zprec_sizeof(prec) result(val)
+  function amg_zprec_sizeof(prec, global) result(val)
     implicit none
     class(amg_zprec_type), intent(in) :: prec
-    integer(psb_epk_) :: val
+    logical, intent(in), optional :: global
+    integer(psb_epk_) :: val    
     integer(psb_ipk_)        :: i
+    type(psb_ctxt_type) :: ctxt
+    
+    logical :: global_
+
+    if (present(global)) then
+      global_ = global
+    else
+      global_ = .false.
+    end if
+    
     val = 0
     val = val + psb_sizeof_ip
     if (allocated(prec%precv)) then
@@ -436,6 +448,11 @@ contains
         val = val + prec%precv(i)%sizeof()
       end do
     end if
+    if (global_) then
+      ctxt = prec%ctxt
+      call psb_sum(ctxt,val)
+    end if
+
   end function amg_zprec_sizeof
 
   !
@@ -738,16 +755,15 @@ contains
     character(len=*), intent(in), optional  :: prefix, head
     logical, optional, intent(in)    :: smoother, solver,ac, rp, tprol, global_num
     integer(psb_ipk_)   :: i, j, il1, iln, lev
-    type(psb_ctxt_type) :: icontxt
+    type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_)   :: iam, np, iproc_
     character(len=80)   :: prefix_
     character(len=120)  :: fname ! len should be at least 20 more than
     !  len of prefix_
 
     info = 0
-    icontxt = prec%ctxt
-    call psb_info(icontxt,iam,np)
-
+    ctxt = prec%ctxt
+    call psb_info(ctxt,iam,np)
     iln = size(prec%precv)
     if (present(istart)) then
       il1 = max(1,istart)
@@ -812,13 +828,13 @@ contains
     integer(psb_ipk_), intent(out)             :: info
     ! Local vars
     integer(psb_ipk_)   :: i, j, ln, lev
-    type(psb_ctxt_type) :: icontxt
+    type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_)   :: iam, np
 
     info = psb_success_
     select type(pout => precout)
     class is (amg_zprec_type)
-      pout%ctxt         = prec%ctxt
+      pout%ctxt          = prec%ctxt
       pout%ag_data       = prec%ag_data
       pout%outer_sweeps  = prec%outer_sweeps
       if (allocated(prec%precv)) then
@@ -834,8 +850,8 @@ contains
           if (info == psb_success_) then
             pout%precv(lev)%base_a       => pout%precv(lev)%ac
             pout%precv(lev)%base_desc    => pout%precv(lev)%desc_ac
-            pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
-            pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
+            pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
+            pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
           end if
         end do
       end if
@@ -875,8 +891,8 @@ contains
       do i=2, size(b%precv)
         b%precv(i)%base_a    => b%precv(i)%ac
         b%precv(i)%base_desc => b%precv(i)%desc_ac
-        b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
-        b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
+        b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
+        b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
       end do
 
     else

amgprec/impl/amg_c_hierarchy_bld.f90

@@ -72,9 +72,9 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
   Implicit None
 
   ! Arguments
-  type(psb_cspmat_type),intent(in), target           :: a
+  type(psb_cspmat_type),intent(in), target             :: a
   type(psb_desc_type), intent(inout), target           :: desc_a
-  class(amg_cprec_type),intent(inout),target          :: prec
+  class(amg_cprec_type),intent(inout),target           :: prec
   integer(psb_ipk_), intent(out)                       :: info
 
   ! Local Variables
@@ -82,7 +82,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
   integer(psb_ipk_)   :: me,np
   integer(psb_ipk_)   :: err,i,k, err_act, iszv, newsz,&
        & nplevs, mxplevs
-  integer(psb_lpk_) :: iaggsize, casize
+  integer(psb_lpk_) :: iaggsize, casize, mncsize, mncszpp
   real(psb_spk_)     :: mnaggratio, sizeratio, athresh, aomega
   class(amg_c_base_smoother_type), allocatable :: coarse_sm, med_sm, &
        & med_sm2, coarse_sm2
@@ -132,17 +132,24 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
   newsz      = -1
   mxplevs    = prec%ag_data%max_levs
   mnaggratio = prec%ag_data%min_cr_ratio
-  casize     = prec%ag_data%min_coarse_size
+  mncsize    = prec%ag_data%min_coarse_size
+  mncszpp    = prec%ag_data%min_coarse_size_per_process
   iszv       = size(prec%precv)
   call psb_bcast(ctxt,iszv)
-  call psb_bcast(ctxt,casize)
+  call psb_bcast(ctxt,mncsize)
+  call psb_bcast(ctxt,mncszpp)
   call psb_bcast(ctxt,mxplevs)
   call psb_bcast(ctxt,mnaggratio)
-  if (casize /= prec%ag_data%min_coarse_size) then 
+  if (mncsize /= prec%ag_data%min_coarse_size) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
     goto 9999
   end if
+  if (mncszpp /= prec%ag_data%min_coarse_size_per_process) then 
+    info=psb_err_internal_error_
+    call psb_errpush(info,name,a_err='Inconsistent min_coarse_size_per_process')
+    goto 9999
+  end if
   if (mxplevs /= prec%ag_data%max_levs) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Inconsistent max_levs')
@@ -175,7 +182,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
     !
     prec%precv(1)%base_a    => a
     prec%precv(1)%base_desc => desc_a
-  
+
     call psb_erractionrestore(err_act)
     return
   endif
@@ -192,26 +199,23 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
   !    coarse size is hit, or the gain falls below the min_cr_ratio
   !    threshold.
   !
-  
-  if (casize < 0) then
-    !
-    ! Default to the cubic root of the size at base level.
-    ! 
-    casize = desc_a%get_global_rows()
-    casize = int((sone*casize)**(sone/(sone*3)),psb_lpk_)
-    casize = max(casize,lone)
-    casize = casize*40_psb_lpk_
-    call psb_bcast(ctxt,casize)
-    if (casize > huge(prec%ag_data%min_coarse_size)) then
-      !
-      ! computed coarse size does not fit in IPK_.
-      ! This is very unlikely, but make sure to put a positive number
-      !
-      prec%ag_data%min_coarse_size = huge(prec%ag_data%min_coarse_size)
-    else
-      prec%ag_data%min_coarse_size = casize
-    end if
+  if ((mncszpp < 0).and.(mncsize<0)) then 
+    mncszpp = 200
+    prec%ag_data%min_coarse_size_per_process = mncszpp
   end if
+  if (mncszpp > 0) then
+    casize = mncszpp*np
+    if (casize > huge(ione)) casize = huge(ione)
+  else
+    if (mncsize < np) then
+      if (me == 0) write(0,*) &
+           & 'Warning: resetting coarse size to NP (1 variable per process)'
+      mncsize = np
+    end if
+    casize = mncsize
+  end if
+  prec%ag_data%target_coarse_size = casize
+  
   nplevs = max(itwo,mxplevs)
 
   !
@@ -248,7 +252,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
       end do
       deallocate(tmp_aggr,stat=info)
     end if
-            
+
     ! Then coarse
     if (info == 0) tprecv(nplevs)%parms = coarseparms
     if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info)
@@ -334,7 +338,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
     if (i==2) then 
       sizeratio = desc_a%get_global_rows()/sizeratio
     else
-      sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
+      sizeratio = sum(prec%precv(i-1)%linmap%naggr)/sizeratio
     end if
     prec%precv(i)%szratio = sizeratio
 
@@ -353,7 +357,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
         end if
       end if
 
-      if (all(nlaggr == prec%precv(i-1)%map%naggr)) then 
+      if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then 
         newsz=i-1
         if (me == 0) then 
           write(debug_unit,*) trim(name),&
@@ -369,7 +373,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
       end if
     end if
     call psb_bcast(ctxt,newsz)
-    
+
     if (newsz > 0) then
       !
       ! This is awkward, we are saving the aggregation parms, for the sake
@@ -380,7 +384,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
       if (info == 0) prec%precv(newsz)%parms = coarseparms
       prec%precv(newsz)%parms%aggr_thresh    =  athresh
       prec%precv(newsz)%parms%aggr_omega_val =  aomega 
-      
+
       if (info == 0) call restore_smoothers(prec%precv(newsz),&
            & coarse_sm,coarse_sm2,info)
       if (newsz < i) then
@@ -388,8 +392,8 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
         ! We are going back and revisit a previous leve;
         ! recover the aggregation.
         !
-        ilaggr = prec%precv(newsz)%map%iaggr
-        nlaggr = prec%precv(newsz)%map%naggr
+        ilaggr = prec%precv(newsz)%linmap%iaggr
+        nlaggr = prec%precv(newsz)%linmap%naggr
         call prec%precv(newsz)%tprol%clone(op_prol,info)
       end if
       if (do_timings) call psb_tic(idx_matasb)      
@@ -450,11 +454,36 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
     do i=2, iszv 
       prec%precv(i)%base_a       => prec%precv(i)%ac
       prec%precv(i)%base_desc    => prec%precv(i)%desc_ac
-      prec%precv(i)%map%p_desc_U => prec%precv(i-1)%base_desc
-      prec%precv(i)%map%p_desc_V => prec%precv(i)%base_desc
+      prec%precv(i)%linmap%p_desc_U => prec%precv(i-1)%base_desc
+      prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc
     end do
   end if
 
+
+  !write(0,*) 'Should we remap? '
+  if (amg_get_do_remap().and.(np>=4)) then
+    write(0,*) 'Going for remapping '
+    if (.true.) then 
+      associate(lv=>prec%precv(iszv), rmp => prec%precv(iszv)%remap_data)
+        call lv%desc_ac%clone(rmp%desc_ac_pre_remap,info)
+        call lv%ac%clone(rmp%ac_pre_remap,info)
+        if (np >= 8) then 
+          call psb_remap(np/4,rmp%desc_ac_pre_remap,rmp%ac_pre_remap,&
+               & rmp%idest,rmp%isrc,rmp%nrsrc,rmp%naggr,lv%desc_ac,lv%ac,info)
+        else
+          call psb_remap(np/2,rmp%desc_ac_pre_remap,rmp%ac_pre_remap,&
+               & rmp%idest,rmp%isrc,rmp%nrsrc,rmp%naggr,lv%desc_ac,lv%ac,info)
+        end if
+        write(0,*) me,' Out of remapping ',rmp%desc_ac_pre_remap%get_fmt(),' ',&
+             & lv%desc_ac%get_fmt(),sum(lv%linmap%naggr),sum(rmp%naggr)
+        lv%linmap%naggr(:)    =  rmp%naggr(:)
+        lv%linmap%p_desc_V => rmp%desc_ac_pre_remap
+        lv%base_a          => lv%ac
+        lv%base_desc       => lv%desc_ac
+      end associate
+    end if
+  end if
+
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_internal_error_,name,&
          & a_err='Internal hierarchy build' )
@@ -500,7 +529,7 @@ contains
       allocate(save2, mold=level%sm2a,stat=info) 
       if (info == 0) call level%sm2a%clone_settings(save2,info)
     end if
-    
+
     return
   end subroutine save_smoothers
 
@@ -519,9 +548,9 @@ contains
       if (info  == 0) allocate(level%sm,mold=save1,stat=info)
       if (info == 0) call save1%clone_settings(level%sm,info)
     end if
-    
+
     if (info /= 0) return
-    
+
     if (allocated(level%sm2a)) then
       if (info  == 0) call level%sm2a%free(info)
       if (info  == 0) deallocate(level%sm2a,stat=info)
@@ -535,6 +564,6 @@ contains
     end if
 
     return
-  end subroutine restore_smoothers    
-  
+  end subroutine restore_smoothers
+
 end subroutine amg_c_hierarchy_bld

amgprec/impl/amg_c_hierarchy_rebld.f90

@@ -127,9 +127,9 @@ subroutine amg_c_hierarchy_rebld(a,desc_a,prec,info)
   do i=2, iszv
     call prec%precv(i-1)%base_a%cp_to(acsr)
     p_desc_a => prec%precv(i-1)%base_desc
-    call prec%precv(i)%map%mat_V2U%cp_to(coo_prol)
-    call prec%precv(i)%map%mat_U2V%cp_to(coo_restr)
-    call amg_rap(acsr,p_desc_a,prec%precv(i)%map%naggr,&
+    call prec%precv(i)%linmap%mat_V2U%cp_to(coo_prol)
+    call prec%precv(i)%linmap%mat_U2V%cp_to(coo_restr)
+    call amg_rap(acsr,p_desc_a,prec%precv(i)%linmap%naggr,&
          & prec%precv(i)%parms,prec%precv(i)%ac,&
          & coo_prol,prec%precv(i)%desc_ac,coo_restr,info)
 

amgprec/impl/amg_c_smoothers_bld.f90

@@ -117,6 +117,10 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
   info = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt, me, np)
+  if (me <0) then
+!!$    write(0,*) 'out of CTXT, should not do anything '
+    goto 9998
+  end if
 
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
@@ -289,6 +293,7 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
     !
     ! build the base preconditioner at level i
     !
+!!$    write(0,*) me,' Building at level ',i
     call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
     
     if (info /= psb_success_) then 
@@ -304,6 +309,7 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Exiting with',iszv,' levels'
 
+9998 continue
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/amg_cfile_prec_descr.f90

@@ -58,17 +58,26 @@
 !             The id of the process printing the message; -1 acts as a wildcard.
 !             Default is psb_root_
 !
-subroutine amg_cfile_prec_descr(prec,iout,root)
+!
+!
+! verbosity:
+!        <0: suppress all messages
+!         0: normal
+!        >1: increased details 
+!
+subroutine amg_cfile_prec_descr(prec,iout,root, verbosity)
   use psb_base_mod
   use amg_c_prec_mod, amg_protect_name => amg_cfile_prec_descr
   use amg_c_inner_mod
   use amg_c_gs_solver
-  
+
   implicit none 
   ! Arguments
   class(amg_cprec_type), intent(in)      :: prec
   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
@@ -76,8 +85,7 @@ subroutine amg_cfile_prec_descr(prec,iout,root)
   integer(psb_ipk_)   :: me, np
   logical             :: is_symgs
   character(len=20), parameter :: name='amg_file_prec_descr'
-  integer(psb_ipk_)  :: iout_
-  integer(psb_ipk_)  :: root_
+  integer(psb_ipk_)  :: iout_, root_, verbosity_
 
   info = psb_success_
   if (present(iout)) then 
@@ -86,6 +94,12 @@ subroutine amg_cfile_prec_descr(prec,iout,root)
     iout_ = psb_out_unit
   end if
   if (iout_ < 0) iout_ = psb_out_unit
+  if (present(verbosity)) then
+    verbosity_ = verbosity
+  else
+    verbosity_ = 0
+  end if
+  if (verbosity_ < 0) goto 9998
 
   ctxt = prec%ctxt
 
@@ -99,102 +113,104 @@ subroutine amg_cfile_prec_descr(prec,iout,root)
     end if
     if (root_ == -1) root_ = me
 
-    !
-    ! The preconditioner description is printed by processor psb_root_.
-    ! This agrees with the fact that all the parameters defining the
-    ! preconditioner have the same values on all the procs (this is
-    ! ensured by amg_precbld).
-    !
-    if (me == root_) then
-      nlev = size(prec%precv)
-      do ilev = 1, nlev 
-        if (.not.allocated(prec%precv(ilev)%sm)) then 
-          info = 3111
-          write(iout_,*) ' ',name,&
-               & ': error: inconsistent MLPREC part, should call amg_PRECINIT'
-          return
-        endif
-      end do
+    if (verbosity_ >=0) then 
+      !
+      ! The preconditioner description is printed by processor psb_root_.
+      ! This agrees with the fact that all the parameters defining the
+      ! preconditioner have the same values on all the procs (this is
+      ! ensured by amg_precbld).
+      !
+      if (me == root_) then
+        nlev = size(prec%precv)
+        do ilev = 1, nlev 
+          if (.not.allocated(prec%precv(ilev)%sm)) then 
+            info = 3111
+            write(iout_,*) ' ',name,&
+                 & ': error: inconsistent MLPREC part, should call amg_PRECINIT'
+            return
+          endif
+        end do
 
-      write(iout_,*) 
-      write(iout_,'(a)') 'Preconditioner description'
+        write(iout_,*) 
+        write(iout_,'(a)') 'Preconditioner description'
 
-      if (nlev == 1) then
-        !
-        ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel.
-        ! Will need rethinking...
-        !
-        if (allocated(prec%precv(1)%sm2a)) then
-          is_symgs = .false.
-          select type(sv2 => prec%precv(1)%sm2a%sv)
-          class is (amg_c_bwgs_solver_type)
-            select type(sv1 => prec%precv(1)%sm%sv)
-            class is (amg_c_gs_solver_type)
-              is_symgs = .true.
+        if (nlev == 1) then
+          !
+          ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel.
+          ! Will need rethinking...
+          !
+          if (allocated(prec%precv(1)%sm2a)) then
+            is_symgs = .false.
+            select type(sv2 => prec%precv(1)%sm2a%sv)
+            class is (amg_c_bwgs_solver_type)
+              select type(sv1 => prec%precv(1)%sm%sv)
+              class is (amg_c_gs_solver_type)
+                is_symgs = .true.
+              end select
             end select
-          end select
-          if (is_symgs) then
-            write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel'
+            if (is_symgs) then
+              write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel'
+            else
+              write(iout_,*) 'Pre Smoother: '
+              call prec%precv(1)%sm%descr(info,iout=iout_)
+              write(iout_,*) 'Post smoother:'
+              call prec%precv(1)%sm2a%descr(info,iout=iout_)
+            end if
+            nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post)
+
           else
+            call prec%precv(1)%sm%descr(info,iout=iout_)
+            nswps = prec%precv(1)%parms%sweeps_pre
+          end if
+          if (nswps > 1)  write(iout_,*) '  Number of  sweeps : ',nswps
+          write(iout_,*) 
+
+        else if (nlev > 1) then
+          !
+          ! Print description of base preconditioner
+          !
+          write(iout_,*) 'Multilevel Preconditioner'
+          write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
+          write(iout_,*) 
+          if (allocated(prec%precv(1)%sm2a)) then
             write(iout_,*) 'Pre Smoother: '
             call prec%precv(1)%sm%descr(info,iout=iout_)
             write(iout_,*) 'Post smoother:'
             call prec%precv(1)%sm2a%descr(info,iout=iout_)
+          else
+            write(iout_,*) 'Smoother: '
+            call prec%precv(1)%sm%descr(info,iout=iout_)
           end if
-          nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post)
+          !
+          ! Print multilevel details
+          !
+          write(iout_,*) 
+          write(iout_,*) 'Multilevel hierarchy: '
+          write(iout_,*) ' Number of levels   : ',nlev
+          write(iout_,*) ' Operator complexity: ',prec%get_complexity()
+          write(iout_,*) ' Average coarsening : ',prec%get_avg_cr()
+          ilmin = 2
+          if (nlev == 2) ilmin=1
+          do ilev=ilmin,nlev
+            call prec%precv(ilev)%descr(ilev,nlev,ilmin,info, &
+                 & iout=iout_,verbosity=verbosity)
+          end do
+          write(iout_,*) 
 
         else
-          call prec%precv(1)%sm%descr(info,iout=iout_)
-          nswps = prec%precv(1)%parms%sweeps_pre
+          write(iout_,*) trim(name), &
+               & ': invalid preconditioner array size ?',nlev
+          info = -2
+          return
+
         end if
-        if (nswps > 1)  write(iout_,*) '  Number of  sweeps : ',nswps
-        write(iout_,*) 
-
-      else if (nlev > 1) then
-        !
-        ! Print description of base preconditioner
-        !
-        write(iout_,*) 'Multilevel Preconditioner'
-        write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
-        write(iout_,*) 
-        if (allocated(prec%precv(1)%sm2a)) then
-          write(iout_,*) 'Pre Smoother: '
-          call prec%precv(1)%sm%descr(info,iout=iout_)
-          write(iout_,*) 'Post smoother:'
-          call prec%precv(1)%sm2a%descr(info,iout=iout_)
-        else
-          write(iout_,*) 'Smoother: '
-          call prec%precv(1)%sm%descr(info,iout=iout_)
-        end if
-        !
-        ! Print multilevel details
-        !
-        write(iout_,*) 
-        write(iout_,*) 'Multilevel hierarchy: '
-        write(iout_,*) ' Number of levels   : ',nlev
-        write(iout_,*) ' Operator complexity: ',prec%get_complexity()
-        write(iout_,*) ' Average coarsening : ',prec%get_avg_cr()
-        ilmin = 2
-        if (nlev == 2) ilmin=1
-        do ilev=ilmin,nlev
-          call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
-        end do
-        write(iout_,*) 
-
-      else
-        write(iout_,*) trim(name), &
-             & ': invalid preconditioner array size ?',nlev
-        info = -2
-        return
-
       end if
     end if
-
   else
     write(iout_,*) trim(name), &
          & ': Error: no base preconditioner available, something is wrong!'
     info = -2
     return
   endif
-
+9998 continue
 end subroutine amg_cfile_prec_descr

amgprec/impl/amg_cmlprec_aply.f90

@@ -393,38 +393,39 @@ contains
     if(debug_level > 1) then
       write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
     end if
-
-    select case(p%precv(level)%parms%ml_cycle) 
-
-    case(amg_no_ml_)
-      !
-      ! No preconditioning, should not really get here
-      ! 
-      call psb_errpush(psb_err_internal_error_,name,&
-           & a_err='amg_no_ml_ in mlprc_aply?')
-      goto 9999      
-
-    case(amg_add_ml_)
-
-      call amg_c_inner_add(p, level, trans, work)
-
-    case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
-
-      call amg_c_inner_mult(p, level, trans, work)
-      
-    case(amg_kcycle_ml_, amg_kcyclesym_ml_)
-
-      call amg_c_inner_k_cycle(p, level, trans, work)
-      
-    case default
-      info = psb_err_from_subroutine_ai_
-      call psb_errpush(info,name,a_err='invalid ml_cycle',&
-           &  i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
-      goto 9999      
-
-    end select
-    if(debug_level > 1) then
-      write(debug_unit,*) me,' End inner_ml_aply at level ',level
+    if (me >= 0) then
+      select case(p%precv(level)%parms%ml_cycle) 
+        
+      case(amg_no_ml_)
+        !
+        ! No preconditioning, should not really get here
+        ! 
+        call psb_errpush(psb_err_internal_error_,name,&
+             & a_err='amg_no_ml_ in mlprc_aply?')
+        goto 9999      
+        
+      case(amg_add_ml_)
+        
+        call amg_c_inner_add(p, level, trans, work)
+        
+      case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
+        
+        call amg_c_inner_mult(p, level, trans, work)
+        
+      case(amg_kcycle_ml_, amg_kcyclesym_ml_)
+        
+        call amg_c_inner_k_cycle(p, level, trans, work)
+        
+      case default
+        info = psb_err_from_subroutine_ai_
+        call psb_errpush(info,name,a_err='invalid ml_cycle',&
+             &  i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
+        goto 9999      
+        
+      end select
+      if(debug_level > 1) then
+        write(debug_unit,*) me,' End inner_ml_aply at level ',level
+      end if
     end if
 
     call psb_erractionrestore(err_act)
@@ -492,28 +493,30 @@ contains
          & base_a => p%precv(level)%base_a, base_desc=>p%precv(level)%base_desc,&
          & wv => p%precv(level)%wrk%wv)
 
-      if (allocated(p%precv(level)%sm2a)) then
-        call psb_geaxpby(cone,vx2l,czero,vy2l,base_desc,info)
-
-        sweeps = max(p%precv(level)%parms%sweeps_pre,p%precv(level)%parms%sweeps_post)
-        do k=1, sweeps
+      if (me >= 0) then 
+        if (allocated(p%precv(level)%sm2a)) then
+          call psb_geaxpby(cone,vx2l,czero,vy2l,base_desc,info)
+          
+          sweeps = max(p%precv(level)%parms%sweeps_pre,p%precv(level)%parms%sweeps_post)
+          do k=1, sweeps
+            call p%precv(level)%sm%apply(cone,&
+                 & vy2l,czero,vty,&
+                 & base_desc, trans,&
+                 & ione,work,wv,info,init='Z')
+            
+            call p%precv(level)%sm2a%apply(cone,&
+                 & vty,czero,vy2l,&
+                 & base_desc, trans,&
+                 & ione,work,wv,info,init='Z')        
+          end do
+          
+        else
+          sweeps = p%precv(level)%parms%sweeps_pre
           call p%precv(level)%sm%apply(cone,&
-               & vy2l,czero,vty,&
+               & vx2l,czero,vy2l,&
                & base_desc, trans,&
-               & ione,work,wv,info,init='Z')
-
-          call p%precv(level)%sm2a%apply(cone,&
-               & vty,czero,vy2l,&
-               & base_desc, trans,&
-               & ione,work,wv,info,init='Z')        
-        end do
-
-      else
-        sweeps = p%precv(level)%parms%sweeps_pre
-        call p%precv(level)%sm%apply(cone,&
-             & vx2l,czero,vy2l,&
-             & base_desc, trans,&
-             & sweeps,work,wv,info,init='Z')
+               & sweeps,work,wv,info,init='Z')
+        end if
       end if
       if (info /= psb_success_) then
         call psb_errpush(psb_err_internal_error_,name,&
@@ -523,7 +526,7 @@ contains
 
       if (level < nlev) then
         ! Apply the restriction
-        call p%precv(level+1)%map%map_U2V(cone,vx2l,&
+        call p%precv(level+1)%map_rstr(cone,vx2l,&
              & czero,p%precv(level+1)%wrk%vx2l,&
              & info,work=work,&
              & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -543,7 +546,7 @@ contains
         !
         ! Apply the prolongator
         !  
-        call p%precv(level+1)%map%map_V2U(cone,&
+        call p%precv(level+1)%map_prol(cone,&
              & p%precv(level+1)%wrk%vy2l, cone,vy2l,&
              & info,work=work,&
              & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -602,7 +605,6 @@ contains
     end if
     ctxt = p%precv(level)%base_desc%get_context()
     call psb_info(ctxt, me, np)
-
     if(debug_level > 1) then
       write(debug_unit,*) me,' inner_mult at level ',level
     end if
@@ -623,22 +625,25 @@ contains
         !
 
         if (pre) then
-          if (trans == 'N') then 
-            sweeps = p%precv(level)%parms%sweeps_pre
-            if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
-                 & vx2l,czero,vy2l,base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
-          else
-            sweeps = p%precv(level)%parms%sweeps_post
-            if (info == psb_success_) call p%precv(level)%sm2%apply(cone,&
-                 & vx2l,czero,vy2l, base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
-          end if
-
-          if (info /= psb_success_) then
-            call psb_errpush(psb_err_internal_error_,name,&
-                 & a_err='Error during PRE smoother_apply')
-            goto 9999
+          if (me >=0) then
+!!$            write(0,*) me,'Applying smoother pre ', level
+            if (trans == 'N') then 
+              sweeps = p%precv(level)%parms%sweeps_pre
+              if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
+                   & vx2l,czero,vy2l,base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            else
+              sweeps = p%precv(level)%parms%sweeps_post
+              if (info == psb_success_) call p%precv(level)%sm2%apply(cone,&
+                   & vx2l,czero,vy2l, base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            end if
+            
+            if (info /= psb_success_) then
+              call psb_errpush(psb_err_internal_error_,name,&
+                   & a_err='Error during PRE smoother_apply')
+              goto 9999
+            end if
           end if
         endif
         !
@@ -657,7 +662,7 @@ contains
                  & a_err='Error during residue')
             goto 9999
           end if
-          call p%precv(level+1)%map%map_U2V(cone,vty,&
+          call p%precv(level+1)%map_rstr(cone,vty,&
                & czero,p%precv(level+1)%wrk%vx2l,&
                & info,work=work,&
                & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -668,7 +673,7 @@ contains
           end if
         else
           ! Shortcut: just transfer x2l. 
-          call p%precv(level+1)%map%map_U2V(cone,vx2l,&
+          call p%precv(level+1)%map_rstr(cone,vx2l,&
                & czero,p%precv(level+1)%wrk%vx2l,&
                & info,work=work,&
                & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -684,7 +689,7 @@ contains
         !
         ! Apply the prolongator
         !  
-        call p%precv(level+1)%map%map_V2U(cone,&
+        call p%precv(level+1)%map_prol(cone,&
              & p%precv(level+1)%wrk%vy2l,cone,vy2l,&
              & info,work=work,&
              & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -696,13 +701,15 @@ contains
 
         if (p%precv(level)%parms%ml_cycle == amg_wcycle_ml_) then
 
-          call psb_geaxpby(cone,vx2l, czero,vty,&
-               & base_desc,info)        
-          if (info == psb_success_) call psb_spmm(-cone,base_a,&
-               & vy2l,cone,vty,&
-               & base_desc,info,work=work,trans=trans)
+          if (me >=0) then 
+            call psb_geaxpby(cone,vx2l, czero,vty,&
+                 & base_desc,info)        
+            if (info == psb_success_) call psb_spmm(-cone,base_a,&
+                 & vy2l,cone,vty,&
+                 & base_desc,info,work=work,trans=trans)
+          end if
           if (info == psb_success_) &
-               & call p%precv(level+1)%map%map_U2V(cone,vty,&
+               & call p%precv(level+1)%map_rstr(cone,vty,&
                & czero,p%precv(level+1)%wrk%vx2l,info,work=work,&
                & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
           if (info /= psb_success_) then
@@ -713,7 +720,7 @@ contains
 
           call inner_ml_aply(level+1,p,trans,work,info)
 
-          if (info == psb_success_) call p%precv(level+1)%map%map_V2U(cone, &
+          if (info == psb_success_) call p%precv(level+1)%map_prol(cone, &
                & p%precv(level+1)%wrk%vy2l,cone,vy2l,&
                & info,work=work,&
                & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -728,31 +735,33 @@ contains
 
 
         if (post) then
-          call psb_geaxpby(cone,vx2l,&
-               & czero,vty,&
-               & base_desc,info)
-          if (info == psb_success_) call psb_spmm(-cone,base_a,&
-               & vy2l, cone,vty,base_desc,info,&
-               & work=work,trans=trans)
-          if (info /= psb_success_) then
-            call psb_errpush(psb_err_internal_error_,name,&
-                 & a_err='Error during residue')
-            goto 9999
-          end if
-
-          !
-          ! Apply the second smoother
-          !
-          if (trans == 'N') then
-            sweeps = p%precv(level)%parms%sweeps_post
-            if (info == psb_success_) call p%precv(level)%sm2%apply(cone,&
-                 & vty,cone,vy2l, base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
-          else 
-            sweeps = p%precv(level)%parms%sweeps_pre
-            if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
-                 & vty,cone,vy2l, base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
+          if (me >=0) then 
+            call psb_geaxpby(cone,vx2l,&
+                 & czero,vty,&
+                 & base_desc,info)
+            if (info == psb_success_) call psb_spmm(-cone,base_a,&
+                 & vy2l, cone,vty,base_desc,info,&
+                 & work=work,trans=trans)
+            if (info /= psb_success_) then
+              call psb_errpush(psb_err_internal_error_,name,&
+                   & a_err='Error during residue')
+              goto 9999
+            end if
+            
+            !
+            ! Apply the second smoother
+            !
+            if (trans == 'N') then
+              sweeps = p%precv(level)%parms%sweeps_post
+              if (info == psb_success_) call p%precv(level)%sm2%apply(cone,&
+                   & vty,cone,vy2l, base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            else 
+              sweeps = p%precv(level)%parms%sweeps_pre
+              if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
+                   & vty,cone,vy2l, base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            end if
           end if
 
           if (info /= psb_success_) then
@@ -764,11 +773,14 @@ contains
         endif
 
       else if (level == nlev) then
-
-        sweeps = p%precv(level)%parms%sweeps_pre
-        if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
-             & vx2l,czero,vy2l,base_desc, trans,&
-             & sweeps,work,wv,info)
+!!$        write(0,*) me,'Applying smoother at top level ',psb_errstatus_fatal()
+        if (me >=0) then 
+          sweeps = p%precv(level)%parms%sweeps_pre
+          if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
+               & vx2l,czero,vy2l,base_desc, trans,&
+               & sweeps,work,wv,info)
+        end if 
+!!$        write(0,*) me,' Done applying smoother at top level ',psb_errstatus_fatal()
 
       else
 
@@ -778,7 +790,7 @@ contains
         goto 9999
       end if
     end associate
-    
+9998 continue
     call psb_erractionrestore(err_act)
     return
 
@@ -829,72 +841,73 @@ contains
     end if
     ctxt = p%precv(level)%base_desc%get_context()
     call psb_info(ctxt, me, np)
-
+    
     if(debug_level > 1) then
       write(debug_unit,*) me,name,' start at level ',level
     end if
-
+    
     if ((level<1).or.(level>nlev)) then
       info = psb_err_internal_error_ 
       call psb_errpush(info,name,&
            & a_err='Invalid LEVEL>NLEV')
       goto 9999
     end if
-
+    
     !K cycle
     
     associate(vx2l => p%precv(level)%wrk%vx2l,vy2l => p%precv(level)%wrk%vy2l,&
          & vtx => p%precv(level)%wrk%vtx,vty => p%precv(level)%wrk%vty,&
          & base_a => p%precv(level)%base_a, base_desc=>p%precv(level)%base_desc,&
          & wv => p%precv(level)%wrk%wv(8:))
+
       if (level == nlev) then 
-        !
-        ! Apply smoother 
-        !
-        sweeps = p%precv(level)%parms%sweeps_pre
-        if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
-             & vx2l,czero,vy2l,base_desc, trans,&
-             & sweeps,work,wv,info,init='Z')
-
-      else  if (level < nlev) then 
-
-        if (trans == 'N') then 
+        if (me >= 0) then 
+          !
+          ! Apply smoother 
+          !
           sweeps = p%precv(level)%parms%sweeps_pre
           if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
                & vx2l,czero,vy2l,base_desc, trans,&
                & sweeps,work,wv,info,init='Z')
-        else
-          sweeps = p%precv(level)%parms%sweeps_post
-          if (info == psb_success_) call p%precv(level)%sm2%apply(cone,&
-               & vx2l,czero,vy2l,base_desc, trans,&
-               & sweeps,work,wv,info,init='Z')
         end if
+      else  if (level < nlev) then 
+        if (me >= 0) then 
 
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during 2-PRE smoother_apply')
-          goto 9999
+          if (trans == 'N') then 
+            sweeps = p%precv(level)%parms%sweeps_pre
+            if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
+                 & vx2l,czero,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          else
+            sweeps = p%precv(level)%parms%sweeps_post
+            if (info == psb_success_) call p%precv(level)%sm2%apply(cone,&
+                 & vx2l,czero,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          end if
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during 2-PRE smoother_apply')
+            goto 9999
+          end if
+
+          !
+          ! Compute the residual and call recursively
+          !
+
+          call psb_geaxpby(cone,vx2l,&
+               & czero,vty,&
+               & base_desc,info)
+
+          if (info == psb_success_) call psb_spmm(-cone,base_a,&
+               & vy2l,cone,vty,base_desc,info,work=work,trans=trans)
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during residue')
+            goto 9999
+          end if
         end if
-
-
-        !
-        ! Compute the residual and call recursively
-        !
-
-        call psb_geaxpby(cone,vx2l,&
-             & czero,vty,&
-             & base_desc,info)
-
-        if (info == psb_success_) call psb_spmm(-cone,base_a,&
-             & vy2l,cone,vty,base_desc,info,work=work,trans=trans)
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during residue')
-          goto 9999
-        end if
-
         ! Apply the restriction
-        call  p%precv(level + 1)%map%map_U2V(cone,vty,&
+        call  p%precv(level + 1)%map_rstr(cone,vty,&
              & czero,p%precv(level + 1)%wrk%vx2l,&
              &info,work=work,&
              & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -930,7 +943,7 @@ contains
         !
         ! Apply the prolongator
         !  
-        call p%precv(level+1)%map%map_V2U(cone,&
+        call p%precv(level+1)%map_prol(cone,&
              & p%precv(level+1)%wrk%vy2l,cone,vy2l,&
              & info,work=work,&
              & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -940,40 +953,42 @@ contains
                & a_err='Error during prolongation')
           goto 9999
         end if
+        if (me >= 0) then 
+          !
+          ! Compute the residual
+          !
+          call psb_geaxpby(cone,vx2l,&
+               & czero,vty,base_desc,info)
+          call psb_spmm(-cone,base_a,vy2l,&
+               & cone,vty,base_desc,info,&
+               & work=work,trans=trans)
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during residue')
+            goto 9999
+          end if
+          !
+          ! Apply the smoother
+          !
+          if (trans == 'N') then 
+            sweeps = p%precv(level)%parms%sweeps_post
+            if (info == psb_success_) call p%precv(level)%sm2%apply(cone,&
+                 & vty,cone,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          else
+            sweeps = p%precv(level)%parms%sweeps_pre
+            if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
+                 & vty,cone,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          end if
 
-        !
-        ! Compute the residual
-        !
-        call psb_geaxpby(cone,vx2l,&
-             & czero,vty,base_desc,info)
-        call psb_spmm(-cone,base_a,vy2l,&
-             & cone,vty,base_desc,info,&
-             & work=work,trans=trans)
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during residue')
-          goto 9999
-        end if
-        !
-        ! Apply the smoother
-        !
-        if (trans == 'N') then 
-          sweeps = p%precv(level)%parms%sweeps_post
-          if (info == psb_success_) call p%precv(level)%sm2%apply(cone,&
-               & vty,cone,vy2l,base_desc, trans,&
-               & sweeps,work,wv,info,init='Z')
-        else
-          sweeps = p%precv(level)%parms%sweeps_pre
-          if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
-               & vty,cone,vy2l,base_desc, trans,&
-               & sweeps,work,wv,info,init='Z')
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during POST smoother_apply')
+            goto 9999
+          end if
         end if
 
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during POST smoother_apply')
-          goto 9999
-        end if
       else
 
         info = psb_err_internal_error_ 
@@ -990,8 +1005,7 @@ contains
     return
 
   end subroutine amg_c_inner_k_cycle
-
-
+  
   recursive subroutine amg_cinneritkcycle(p, level, trans, work, innersolv)
     use psb_base_mod
     use amg_prec_mod
@@ -1423,7 +1437,7 @@ contains
 
     if (level < nlev) then
       ! Apply the restriction
-      call p%precv(level+1)%map%map_U2V(cone,mlwrk(level)%x2l,&
+      call p%precv(level+1)%map_rstr(cone,mlwrk(level)%x2l,&
            & czero,mlwrk(level+1)%x2l,&
            & info,work=work)
       mlwrk(level+1)%y2l(:) = czero
@@ -1443,7 +1457,7 @@ contains
       !
       ! Apply the prolongator and add correction.
       !  
-      call p%precv(level+1)%map%map_V2U(cone,&
+      call p%precv(level+1)%map_prol(cone,&
            & mlwrk(level+1)%y2l,cone,mlwrk(level)%y2l,&
            & info,work=work)
       if (info /= psb_success_) then
@@ -1564,7 +1578,7 @@ contains
                & a_err='Error during residue')
           goto 9999
         end if
-        call p%precv(level+1)%map%map_U2V(cone,mlwrk(level)%ty,&
+        call p%precv(level+1)%map_rstr(cone,mlwrk(level)%ty,&
              & czero,mlwrk(level+1)%x2l,info,work=work)
         if (info /= psb_success_) then
           call psb_errpush(psb_err_internal_error_,name,&
@@ -1573,7 +1587,7 @@ contains
         end if
       else
         ! Shortcut: just transfer x2l. 
-        call p%precv(level+1)%map%map_U2V(cone,mlwrk(level)%x2l,&
+        call p%precv(level+1)%map_rstr(cone,mlwrk(level)%x2l,&
              & czero,mlwrk(level+1)%x2l,info,work=work)
         if (info /= psb_success_) then
           call psb_errpush(psb_err_internal_error_,name,&
@@ -1602,7 +1616,7 @@ contains
       !
       ! Apply the prolongator
       !  
-      call p%precv(level+1)%map%map_V2U(cone,mlwrk(level+1)%y2l,&
+      call p%precv(level+1)%map_prol(cone,mlwrk(level+1)%y2l,&
            & cone,mlwrk(level)%y2l,info,work=work)
       if (info /= psb_success_) then
         call psb_errpush(psb_err_internal_error_,name,&

amgprec/impl/amg_cprecinit.F90

@@ -124,7 +124,8 @@ subroutine amg_cprecinit(ctxt,prec,ptype,info)
     endif
   endif
   prec%ctxt = ctxt
-  prec%ag_data%min_coarse_size = -1
+  prec%ag_data%min_coarse_size             = -1
+  prec%ag_data%min_coarse_size_per_process = -1
 
   select case(psb_toupper(trim(ptype)))
   case ('NOPREC','NONE') 

amgprec/impl/amg_d_hierarchy_bld.f90

@@ -72,9 +72,9 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
   Implicit None
 
   ! Arguments
-  type(psb_dspmat_type),intent(in), target           :: a
+  type(psb_dspmat_type),intent(in), target             :: a
   type(psb_desc_type), intent(inout), target           :: desc_a
-  class(amg_dprec_type),intent(inout),target          :: prec
+  class(amg_dprec_type),intent(inout),target           :: prec
   integer(psb_ipk_), intent(out)                       :: info
 
   ! Local Variables
@@ -82,7 +82,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
   integer(psb_ipk_)   :: me,np
   integer(psb_ipk_)   :: err,i,k, err_act, iszv, newsz,&
        & nplevs, mxplevs
-  integer(psb_lpk_) :: iaggsize, casize
+  integer(psb_lpk_) :: iaggsize, casize, mncsize, mncszpp
   real(psb_dpk_)     :: mnaggratio, sizeratio, athresh, aomega
   class(amg_d_base_smoother_type), allocatable :: coarse_sm, med_sm, &
        & med_sm2, coarse_sm2
@@ -132,17 +132,24 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
   newsz      = -1
   mxplevs    = prec%ag_data%max_levs
   mnaggratio = prec%ag_data%min_cr_ratio
-  casize     = prec%ag_data%min_coarse_size
+  mncsize    = prec%ag_data%min_coarse_size
+  mncszpp    = prec%ag_data%min_coarse_size_per_process
   iszv       = size(prec%precv)
   call psb_bcast(ctxt,iszv)
-  call psb_bcast(ctxt,casize)
+  call psb_bcast(ctxt,mncsize)
+  call psb_bcast(ctxt,mncszpp)
   call psb_bcast(ctxt,mxplevs)
   call psb_bcast(ctxt,mnaggratio)
-  if (casize /= prec%ag_data%min_coarse_size) then 
+  if (mncsize /= prec%ag_data%min_coarse_size) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
     goto 9999
   end if
+  if (mncszpp /= prec%ag_data%min_coarse_size_per_process) then 
+    info=psb_err_internal_error_
+    call psb_errpush(info,name,a_err='Inconsistent min_coarse_size_per_process')
+    goto 9999
+  end if
   if (mxplevs /= prec%ag_data%max_levs) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Inconsistent max_levs')
@@ -175,7 +182,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
     !
     prec%precv(1)%base_a    => a
     prec%precv(1)%base_desc => desc_a
-  
+
     call psb_erractionrestore(err_act)
     return
   endif
@@ -192,26 +199,23 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
   !    coarse size is hit, or the gain falls below the min_cr_ratio
   !    threshold.
   !
-  
-  if (casize < 0) then
-    !
-    ! Default to the cubic root of the size at base level.
-    ! 
-    casize = desc_a%get_global_rows()
-    casize = int((done*casize)**(done/(done*3)),psb_lpk_)
-    casize = max(casize,lone)
-    casize = casize*40_psb_lpk_
-    call psb_bcast(ctxt,casize)
-    if (casize > huge(prec%ag_data%min_coarse_size)) then
-      !
-      ! computed coarse size does not fit in IPK_.
-      ! This is very unlikely, but make sure to put a positive number
-      !
-      prec%ag_data%min_coarse_size = huge(prec%ag_data%min_coarse_size)
-    else
-      prec%ag_data%min_coarse_size = casize
-    end if
+  if ((mncszpp < 0).and.(mncsize<0)) then 
+    mncszpp = 200
+    prec%ag_data%min_coarse_size_per_process = mncszpp
   end if
+  if (mncszpp > 0) then
+    casize = mncszpp*np
+    if (casize > huge(ione)) casize = huge(ione)
+  else
+    if (mncsize < np) then
+      if (me == 0) write(0,*) &
+           & 'Warning: resetting coarse size to NP (1 variable per process)'
+      mncsize = np
+    end if
+    casize = mncsize
+  end if
+  prec%ag_data%target_coarse_size = casize
+  
   nplevs = max(itwo,mxplevs)
 
   !
@@ -248,7 +252,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
       end do
       deallocate(tmp_aggr,stat=info)
     end if
-            
+
     ! Then coarse
     if (info == 0) tprecv(nplevs)%parms = coarseparms
     if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info)
@@ -334,7 +338,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
     if (i==2) then 
       sizeratio = desc_a%get_global_rows()/sizeratio
     else
-      sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
+      sizeratio = sum(prec%precv(i-1)%linmap%naggr)/sizeratio
     end if
     prec%precv(i)%szratio = sizeratio
 
@@ -353,7 +357,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
         end if
       end if
 
-      if (all(nlaggr == prec%precv(i-1)%map%naggr)) then 
+      if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then 
         newsz=i-1
         if (me == 0) then 
           write(debug_unit,*) trim(name),&
@@ -369,7 +373,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
       end if
     end if
     call psb_bcast(ctxt,newsz)
-    
+
     if (newsz > 0) then
       !
       ! This is awkward, we are saving the aggregation parms, for the sake
@@ -380,7 +384,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
       if (info == 0) prec%precv(newsz)%parms = coarseparms
       prec%precv(newsz)%parms%aggr_thresh    =  athresh
       prec%precv(newsz)%parms%aggr_omega_val =  aomega 
-      
+
       if (info == 0) call restore_smoothers(prec%precv(newsz),&
            & coarse_sm,coarse_sm2,info)
       if (newsz < i) then
@@ -388,8 +392,8 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
         ! We are going back and revisit a previous leve;
         ! recover the aggregation.
         !
-        ilaggr = prec%precv(newsz)%map%iaggr
-        nlaggr = prec%precv(newsz)%map%naggr
+        ilaggr = prec%precv(newsz)%linmap%iaggr
+        nlaggr = prec%precv(newsz)%linmap%naggr
         call prec%precv(newsz)%tprol%clone(op_prol,info)
       end if
       if (do_timings) call psb_tic(idx_matasb)      
@@ -450,11 +454,36 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
     do i=2, iszv 
       prec%precv(i)%base_a       => prec%precv(i)%ac
       prec%precv(i)%base_desc    => prec%precv(i)%desc_ac
-      prec%precv(i)%map%p_desc_U => prec%precv(i-1)%base_desc
-      prec%precv(i)%map%p_desc_V => prec%precv(i)%base_desc
+      prec%precv(i)%linmap%p_desc_U => prec%precv(i-1)%base_desc
+      prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc
     end do
   end if
 
+
+  !write(0,*) 'Should we remap? '
+  if (amg_get_do_remap().and.(np>=4)) then
+    write(0,*) 'Going for remapping '
+    if (.true.) then 
+      associate(lv=>prec%precv(iszv), rmp => prec%precv(iszv)%remap_data)
+        call lv%desc_ac%clone(rmp%desc_ac_pre_remap,info)
+        call lv%ac%clone(rmp%ac_pre_remap,info)
+        if (np >= 8) then 
+          call psb_remap(np/4,rmp%desc_ac_pre_remap,rmp%ac_pre_remap,&
+               & rmp%idest,rmp%isrc,rmp%nrsrc,rmp%naggr,lv%desc_ac,lv%ac,info)
+        else
+          call psb_remap(np/2,rmp%desc_ac_pre_remap,rmp%ac_pre_remap,&
+               & rmp%idest,rmp%isrc,rmp%nrsrc,rmp%naggr,lv%desc_ac,lv%ac,info)
+        end if
+        write(0,*) me,' Out of remapping ',rmp%desc_ac_pre_remap%get_fmt(),' ',&
+             & lv%desc_ac%get_fmt(),sum(lv%linmap%naggr),sum(rmp%naggr)
+        lv%linmap%naggr(:)    =  rmp%naggr(:)
+        lv%linmap%p_desc_V => rmp%desc_ac_pre_remap
+        lv%base_a          => lv%ac
+        lv%base_desc       => lv%desc_ac
+      end associate
+    end if
+  end if
+
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_internal_error_,name,&
          & a_err='Internal hierarchy build' )
@@ -500,7 +529,7 @@ contains
       allocate(save2, mold=level%sm2a,stat=info) 
       if (info == 0) call level%sm2a%clone_settings(save2,info)
     end if
-    
+
     return
   end subroutine save_smoothers
 
@@ -519,9 +548,9 @@ contains
       if (info  == 0) allocate(level%sm,mold=save1,stat=info)
       if (info == 0) call save1%clone_settings(level%sm,info)
     end if
-    
+
     if (info /= 0) return
-    
+
     if (allocated(level%sm2a)) then
       if (info  == 0) call level%sm2a%free(info)
       if (info  == 0) deallocate(level%sm2a,stat=info)
@@ -535,6 +564,6 @@ contains
     end if
 
     return
-  end subroutine restore_smoothers    
-  
+  end subroutine restore_smoothers
+
 end subroutine amg_d_hierarchy_bld

amgprec/impl/amg_d_hierarchy_rebld.f90

@@ -127,9 +127,9 @@ subroutine amg_d_hierarchy_rebld(a,desc_a,prec,info)
   do i=2, iszv
     call prec%precv(i-1)%base_a%cp_to(acsr)
     p_desc_a => prec%precv(i-1)%base_desc
-    call prec%precv(i)%map%mat_V2U%cp_to(coo_prol)
-    call prec%precv(i)%map%mat_U2V%cp_to(coo_restr)
-    call amg_rap(acsr,p_desc_a,prec%precv(i)%map%naggr,&
+    call prec%precv(i)%linmap%mat_V2U%cp_to(coo_prol)
+    call prec%precv(i)%linmap%mat_U2V%cp_to(coo_restr)
+    call amg_rap(acsr,p_desc_a,prec%precv(i)%linmap%naggr,&
          & prec%precv(i)%parms,prec%precv(i)%ac,&
          & coo_prol,prec%precv(i)%desc_ac,coo_restr,info)
 

amgprec/impl/amg_d_smoothers_bld.f90

@@ -117,6 +117,10 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
   info = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt, me, np)
+  if (me <0) then
+!!$    write(0,*) 'out of CTXT, should not do anything '
+    goto 9998
+  end if
 
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
@@ -289,6 +293,7 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
     !
     ! build the base preconditioner at level i
     !
+!!$    write(0,*) me,' Building at level ',i
     call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
     
     if (info /= psb_success_) then 
@@ -304,6 +309,7 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Exiting with',iszv,' levels'
 
+9998 continue
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/amg_dfile_prec_descr.f90

@@ -58,17 +58,26 @@
 !             The id of the process printing the message; -1 acts as a wildcard.
 !             Default is psb_root_
 !
-subroutine amg_dfile_prec_descr(prec,iout,root)
+!
+!
+! verbosity:
+!        <0: suppress all messages
+!         0: normal
+!        >1: increased details 
+!
+subroutine amg_dfile_prec_descr(prec,iout,root, verbosity)
   use psb_base_mod
   use amg_d_prec_mod, amg_protect_name => amg_dfile_prec_descr
   use amg_d_inner_mod
   use amg_d_gs_solver
-  
+
   implicit none 
   ! Arguments
   class(amg_dprec_type), intent(in)      :: prec
   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
@@ -76,8 +85,7 @@ subroutine amg_dfile_prec_descr(prec,iout,root)
   integer(psb_ipk_)   :: me, np
   logical             :: is_symgs
   character(len=20), parameter :: name='amg_file_prec_descr'
-  integer(psb_ipk_)  :: iout_
-  integer(psb_ipk_)  :: root_
+  integer(psb_ipk_)  :: iout_, root_, verbosity_
 
   info = psb_success_
   if (present(iout)) then 
@@ -86,6 +94,12 @@ subroutine amg_dfile_prec_descr(prec,iout,root)
     iout_ = psb_out_unit
   end if
   if (iout_ < 0) iout_ = psb_out_unit
+  if (present(verbosity)) then
+    verbosity_ = verbosity
+  else
+    verbosity_ = 0
+  end if
+  if (verbosity_ < 0) goto 9998
 
   ctxt = prec%ctxt
 
@@ -99,102 +113,104 @@ subroutine amg_dfile_prec_descr(prec,iout,root)
     end if
     if (root_ == -1) root_ = me
 
-    !
-    ! The preconditioner description is printed by processor psb_root_.
-    ! This agrees with the fact that all the parameters defining the
-    ! preconditioner have the same values on all the procs (this is
-    ! ensured by amg_precbld).
-    !
-    if (me == root_) then
-      nlev = size(prec%precv)
-      do ilev = 1, nlev 
-        if (.not.allocated(prec%precv(ilev)%sm)) then 
-          info = 3111
-          write(iout_,*) ' ',name,&
-               & ': error: inconsistent MLPREC part, should call amg_PRECINIT'
-          return
-        endif
-      end do
+    if (verbosity_ >=0) then 
+      !
+      ! The preconditioner description is printed by processor psb_root_.
+      ! This agrees with the fact that all the parameters defining the
+      ! preconditioner have the same values on all the procs (this is
+      ! ensured by amg_precbld).
+      !
+      if (me == root_) then
+        nlev = size(prec%precv)
+        do ilev = 1, nlev 
+          if (.not.allocated(prec%precv(ilev)%sm)) then 
+            info = 3111
+            write(iout_,*) ' ',name,&
+                 & ': error: inconsistent MLPREC part, should call amg_PRECINIT'
+            return
+          endif
+        end do
 
-      write(iout_,*) 
-      write(iout_,'(a)') 'Preconditioner description'
+        write(iout_,*) 
+        write(iout_,'(a)') 'Preconditioner description'
 
-      if (nlev == 1) then
-        !
-        ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel.
-        ! Will need rethinking...
-        !
-        if (allocated(prec%precv(1)%sm2a)) then
-          is_symgs = .false.
-          select type(sv2 => prec%precv(1)%sm2a%sv)
-          class is (amg_d_bwgs_solver_type)
-            select type(sv1 => prec%precv(1)%sm%sv)
-            class is (amg_d_gs_solver_type)
-              is_symgs = .true.
+        if (nlev == 1) then
+          !
+          ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel.
+          ! Will need rethinking...
+          !
+          if (allocated(prec%precv(1)%sm2a)) then
+            is_symgs = .false.
+            select type(sv2 => prec%precv(1)%sm2a%sv)
+            class is (amg_d_bwgs_solver_type)
+              select type(sv1 => prec%precv(1)%sm%sv)
+              class is (amg_d_gs_solver_type)
+                is_symgs = .true.
+              end select
             end select
-          end select
-          if (is_symgs) then
-            write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel'
+            if (is_symgs) then
+              write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel'
+            else
+              write(iout_,*) 'Pre Smoother: '
+              call prec%precv(1)%sm%descr(info,iout=iout_)
+              write(iout_,*) 'Post smoother:'
+              call prec%precv(1)%sm2a%descr(info,iout=iout_)
+            end if
+            nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post)
+
           else
+            call prec%precv(1)%sm%descr(info,iout=iout_)
+            nswps = prec%precv(1)%parms%sweeps_pre
+          end if
+          if (nswps > 1)  write(iout_,*) '  Number of  sweeps : ',nswps
+          write(iout_,*) 
+
+        else if (nlev > 1) then
+          !
+          ! Print description of base preconditioner
+          !
+          write(iout_,*) 'Multilevel Preconditioner'
+          write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
+          write(iout_,*) 
+          if (allocated(prec%precv(1)%sm2a)) then
             write(iout_,*) 'Pre Smoother: '
             call prec%precv(1)%sm%descr(info,iout=iout_)
             write(iout_,*) 'Post smoother:'
             call prec%precv(1)%sm2a%descr(info,iout=iout_)
+          else
+            write(iout_,*) 'Smoother: '
+            call prec%precv(1)%sm%descr(info,iout=iout_)
           end if
-          nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post)
+          !
+          ! Print multilevel details
+          !
+          write(iout_,*) 
+          write(iout_,*) 'Multilevel hierarchy: '
+          write(iout_,*) ' Number of levels   : ',nlev
+          write(iout_,*) ' Operator complexity: ',prec%get_complexity()
+          write(iout_,*) ' Average coarsening : ',prec%get_avg_cr()
+          ilmin = 2
+          if (nlev == 2) ilmin=1
+          do ilev=ilmin,nlev
+            call prec%precv(ilev)%descr(ilev,nlev,ilmin,info, &
+                 & iout=iout_,verbosity=verbosity)
+          end do
+          write(iout_,*) 
 
         else
-          call prec%precv(1)%sm%descr(info,iout=iout_)
-          nswps = prec%precv(1)%parms%sweeps_pre
+          write(iout_,*) trim(name), &
+               & ': invalid preconditioner array size ?',nlev
+          info = -2
+          return
+
         end if
-        if (nswps > 1)  write(iout_,*) '  Number of  sweeps : ',nswps
-        write(iout_,*) 
-
-      else if (nlev > 1) then
-        !
-        ! Print description of base preconditioner
-        !
-        write(iout_,*) 'Multilevel Preconditioner'
-        write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
-        write(iout_,*) 
-        if (allocated(prec%precv(1)%sm2a)) then
-          write(iout_,*) 'Pre Smoother: '
-          call prec%precv(1)%sm%descr(info,iout=iout_)
-          write(iout_,*) 'Post smoother:'
-          call prec%precv(1)%sm2a%descr(info,iout=iout_)
-        else
-          write(iout_,*) 'Smoother: '
-          call prec%precv(1)%sm%descr(info,iout=iout_)
-        end if
-        !
-        ! Print multilevel details
-        !
-        write(iout_,*) 
-        write(iout_,*) 'Multilevel hierarchy: '
-        write(iout_,*) ' Number of levels   : ',nlev
-        write(iout_,*) ' Operator complexity: ',prec%get_complexity()
-        write(iout_,*) ' Average coarsening : ',prec%get_avg_cr()
-        ilmin = 2
-        if (nlev == 2) ilmin=1
-        do ilev=ilmin,nlev
-          call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
-        end do
-        write(iout_,*) 
-
-      else
-        write(iout_,*) trim(name), &
-             & ': invalid preconditioner array size ?',nlev
-        info = -2
-        return
-
       end if
     end if
-
   else
     write(iout_,*) trim(name), &
          & ': Error: no base preconditioner available, something is wrong!'
     info = -2
     return
   endif
-
+9998 continue
 end subroutine amg_dfile_prec_descr

amgprec/impl/amg_dmlprec_aply.f90

@@ -393,38 +393,39 @@ contains
     if(debug_level > 1) then
       write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
     end if
-
-    select case(p%precv(level)%parms%ml_cycle) 
-
-    case(amg_no_ml_)
-      !
-      ! No preconditioning, should not really get here
-      ! 
-      call psb_errpush(psb_err_internal_error_,name,&
-           & a_err='amg_no_ml_ in mlprc_aply?')
-      goto 9999      
-
-    case(amg_add_ml_)
-
-      call amg_d_inner_add(p, level, trans, work)
-
-    case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
-
-      call amg_d_inner_mult(p, level, trans, work)
-      
-    case(amg_kcycle_ml_, amg_kcyclesym_ml_)
-
-      call amg_d_inner_k_cycle(p, level, trans, work)
-      
-    case default
-      info = psb_err_from_subroutine_ai_
-      call psb_errpush(info,name,a_err='invalid ml_cycle',&
-           &  i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
-      goto 9999      
-
-    end select
-    if(debug_level > 1) then
-      write(debug_unit,*) me,' End inner_ml_aply at level ',level
+    if (me >= 0) then
+      select case(p%precv(level)%parms%ml_cycle) 
+        
+      case(amg_no_ml_)
+        !
+        ! No preconditioning, should not really get here
+        ! 
+        call psb_errpush(psb_err_internal_error_,name,&
+             & a_err='amg_no_ml_ in mlprc_aply?')
+        goto 9999      
+        
+      case(amg_add_ml_)
+        
+        call amg_d_inner_add(p, level, trans, work)
+        
+      case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
+        
+        call amg_d_inner_mult(p, level, trans, work)
+        
+      case(amg_kcycle_ml_, amg_kcyclesym_ml_)
+        
+        call amg_d_inner_k_cycle(p, level, trans, work)
+        
+      case default
+        info = psb_err_from_subroutine_ai_
+        call psb_errpush(info,name,a_err='invalid ml_cycle',&
+             &  i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
+        goto 9999      
+        
+      end select
+      if(debug_level > 1) then
+        write(debug_unit,*) me,' End inner_ml_aply at level ',level
+      end if
     end if
 
     call psb_erractionrestore(err_act)
@@ -492,28 +493,30 @@ contains
          & base_a => p%precv(level)%base_a, base_desc=>p%precv(level)%base_desc,&
          & wv => p%precv(level)%wrk%wv)
 
-      if (allocated(p%precv(level)%sm2a)) then
-        call psb_geaxpby(done,vx2l,dzero,vy2l,base_desc,info)
-
-        sweeps = max(p%precv(level)%parms%sweeps_pre,p%precv(level)%parms%sweeps_post)
-        do k=1, sweeps
+      if (me >= 0) then 
+        if (allocated(p%precv(level)%sm2a)) then
+          call psb_geaxpby(done,vx2l,dzero,vy2l,base_desc,info)
+          
+          sweeps = max(p%precv(level)%parms%sweeps_pre,p%precv(level)%parms%sweeps_post)
+          do k=1, sweeps
+            call p%precv(level)%sm%apply(done,&
+                 & vy2l,dzero,vty,&
+                 & base_desc, trans,&
+                 & ione,work,wv,info,init='Z')
+            
+            call p%precv(level)%sm2a%apply(done,&
+                 & vty,dzero,vy2l,&
+                 & base_desc, trans,&
+                 & ione,work,wv,info,init='Z')        
+          end do
+          
+        else
+          sweeps = p%precv(level)%parms%sweeps_pre
           call p%precv(level)%sm%apply(done,&
-               & vy2l,dzero,vty,&
+               & vx2l,dzero,vy2l,&
                & base_desc, trans,&
-               & ione,work,wv,info,init='Z')
-
-          call p%precv(level)%sm2a%apply(done,&
-               & vty,dzero,vy2l,&
-               & base_desc, trans,&
-               & ione,work,wv,info,init='Z')        
-        end do
-
-      else
-        sweeps = p%precv(level)%parms%sweeps_pre
-        call p%precv(level)%sm%apply(done,&
-             & vx2l,dzero,vy2l,&
-             & base_desc, trans,&
-             & sweeps,work,wv,info,init='Z')
+               & sweeps,work,wv,info,init='Z')
+        end if
       end if
       if (info /= psb_success_) then
         call psb_errpush(psb_err_internal_error_,name,&
@@ -523,7 +526,7 @@ contains
 
       if (level < nlev) then
         ! Apply the restriction
-        call p%precv(level+1)%map%map_U2V(done,vx2l,&
+        call p%precv(level+1)%map_rstr(done,vx2l,&
              & dzero,p%precv(level+1)%wrk%vx2l,&
              & info,work=work,&
              & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -543,7 +546,7 @@ contains
         !
         ! Apply the prolongator
         !  
-        call p%precv(level+1)%map%map_V2U(done,&
+        call p%precv(level+1)%map_prol(done,&
              & p%precv(level+1)%wrk%vy2l, done,vy2l,&
              & info,work=work,&
              & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -602,7 +605,6 @@ contains
     end if
     ctxt = p%precv(level)%base_desc%get_context()
     call psb_info(ctxt, me, np)
-
     if(debug_level > 1) then
       write(debug_unit,*) me,' inner_mult at level ',level
     end if
@@ -623,22 +625,25 @@ contains
         !
 
         if (pre) then
-          if (trans == 'N') then 
-            sweeps = p%precv(level)%parms%sweeps_pre
-            if (info == psb_success_) call p%precv(level)%sm%apply(done,&
-                 & vx2l,dzero,vy2l,base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
-          else
-            sweeps = p%precv(level)%parms%sweeps_post
-            if (info == psb_success_) call p%precv(level)%sm2%apply(done,&
-                 & vx2l,dzero,vy2l, base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
-          end if
-
-          if (info /= psb_success_) then
-            call psb_errpush(psb_err_internal_error_,name,&
-                 & a_err='Error during PRE smoother_apply')
-            goto 9999
+          if (me >=0) then
+!!$            write(0,*) me,'Applying smoother pre ', level
+            if (trans == 'N') then 
+              sweeps = p%precv(level)%parms%sweeps_pre
+              if (info == psb_success_) call p%precv(level)%sm%apply(done,&
+                   & vx2l,dzero,vy2l,base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            else
+              sweeps = p%precv(level)%parms%sweeps_post
+              if (info == psb_success_) call p%precv(level)%sm2%apply(done,&
+                   & vx2l,dzero,vy2l, base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            end if
+            
+            if (info /= psb_success_) then
+              call psb_errpush(psb_err_internal_error_,name,&
+                   & a_err='Error during PRE smoother_apply')
+              goto 9999
+            end if
           end if
         endif
         !
@@ -657,7 +662,7 @@ contains
                  & a_err='Error during residue')
             goto 9999
           end if
-          call p%precv(level+1)%map%map_U2V(done,vty,&
+          call p%precv(level+1)%map_rstr(done,vty,&
                & dzero,p%precv(level+1)%wrk%vx2l,&
                & info,work=work,&
                & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -668,7 +673,7 @@ contains
           end if
         else
           ! Shortcut: just transfer x2l. 
-          call p%precv(level+1)%map%map_U2V(done,vx2l,&
+          call p%precv(level+1)%map_rstr(done,vx2l,&
                & dzero,p%precv(level+1)%wrk%vx2l,&
                & info,work=work,&
                & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -684,7 +689,7 @@ contains
         !
         ! Apply the prolongator
         !  
-        call p%precv(level+1)%map%map_V2U(done,&
+        call p%precv(level+1)%map_prol(done,&
              & p%precv(level+1)%wrk%vy2l,done,vy2l,&
              & info,work=work,&
              & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -696,13 +701,15 @@ contains
 
         if (p%precv(level)%parms%ml_cycle == amg_wcycle_ml_) then
 
-          call psb_geaxpby(done,vx2l, dzero,vty,&
-               & base_desc,info)        
-          if (info == psb_success_) call psb_spmm(-done,base_a,&
-               & vy2l,done,vty,&
-               & base_desc,info,work=work,trans=trans)
+          if (me >=0) then 
+            call psb_geaxpby(done,vx2l, dzero,vty,&
+                 & base_desc,info)        
+            if (info == psb_success_) call psb_spmm(-done,base_a,&
+                 & vy2l,done,vty,&
+                 & base_desc,info,work=work,trans=trans)
+          end if
           if (info == psb_success_) &
-               & call p%precv(level+1)%map%map_U2V(done,vty,&
+               & call p%precv(level+1)%map_rstr(done,vty,&
                & dzero,p%precv(level+1)%wrk%vx2l,info,work=work,&
                & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
           if (info /= psb_success_) then
@@ -713,7 +720,7 @@ contains
 
           call inner_ml_aply(level+1,p,trans,work,info)
 
-          if (info == psb_success_) call p%precv(level+1)%map%map_V2U(done, &
+          if (info == psb_success_) call p%precv(level+1)%map_prol(done, &
                & p%precv(level+1)%wrk%vy2l,done,vy2l,&
                & info,work=work,&
                & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -728,31 +735,33 @@ contains
 
 
         if (post) then
-          call psb_geaxpby(done,vx2l,&
-               & dzero,vty,&
-               & base_desc,info)
-          if (info == psb_success_) call psb_spmm(-done,base_a,&
-               & vy2l, done,vty,base_desc,info,&
-               & work=work,trans=trans)
-          if (info /= psb_success_) then
-            call psb_errpush(psb_err_internal_error_,name,&
-                 & a_err='Error during residue')
-            goto 9999
-          end if
-
-          !
-          ! Apply the second smoother
-          !
-          if (trans == 'N') then
-            sweeps = p%precv(level)%parms%sweeps_post
-            if (info == psb_success_) call p%precv(level)%sm2%apply(done,&
-                 & vty,done,vy2l, base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
-          else 
-            sweeps = p%precv(level)%parms%sweeps_pre
-            if (info == psb_success_) call p%precv(level)%sm%apply(done,&
-                 & vty,done,vy2l, base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
+          if (me >=0) then 
+            call psb_geaxpby(done,vx2l,&
+                 & dzero,vty,&
+                 & base_desc,info)
+            if (info == psb_success_) call psb_spmm(-done,base_a,&
+                 & vy2l, done,vty,base_desc,info,&
+                 & work=work,trans=trans)
+            if (info /= psb_success_) then
+              call psb_errpush(psb_err_internal_error_,name,&
+                   & a_err='Error during residue')
+              goto 9999
+            end if
+            
+            !
+            ! Apply the second smoother
+            !
+            if (trans == 'N') then
+              sweeps = p%precv(level)%parms%sweeps_post
+              if (info == psb_success_) call p%precv(level)%sm2%apply(done,&
+                   & vty,done,vy2l, base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            else 
+              sweeps = p%precv(level)%parms%sweeps_pre
+              if (info == psb_success_) call p%precv(level)%sm%apply(done,&
+                   & vty,done,vy2l, base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            end if
           end if
 
           if (info /= psb_success_) then
@@ -764,11 +773,14 @@ contains
         endif
 
       else if (level == nlev) then
-
-        sweeps = p%precv(level)%parms%sweeps_pre
-        if (info == psb_success_) call p%precv(level)%sm%apply(done,&
-             & vx2l,dzero,vy2l,base_desc, trans,&
-             & sweeps,work,wv,info)
+!!$        write(0,*) me,'Applying smoother at top level ',psb_errstatus_fatal()
+        if (me >=0) then 
+          sweeps = p%precv(level)%parms%sweeps_pre
+          if (info == psb_success_) call p%precv(level)%sm%apply(done,&
+               & vx2l,dzero,vy2l,base_desc, trans,&
+               & sweeps,work,wv,info)
+        end if 
+!!$        write(0,*) me,' Done applying smoother at top level ',psb_errstatus_fatal()
 
       else
 
@@ -778,7 +790,7 @@ contains
         goto 9999
       end if
     end associate
-    
+9998 continue
     call psb_erractionrestore(err_act)
     return
 
@@ -829,72 +841,73 @@ contains
     end if
     ctxt = p%precv(level)%base_desc%get_context()
     call psb_info(ctxt, me, np)
-
+    
     if(debug_level > 1) then
       write(debug_unit,*) me,name,' start at level ',level
     end if
-
+    
     if ((level<1).or.(level>nlev)) then
       info = psb_err_internal_error_ 
       call psb_errpush(info,name,&
            & a_err='Invalid LEVEL>NLEV')
       goto 9999
     end if
-
+    
     !K cycle
     
     associate(vx2l => p%precv(level)%wrk%vx2l,vy2l => p%precv(level)%wrk%vy2l,&
          & vtx => p%precv(level)%wrk%vtx,vty => p%precv(level)%wrk%vty,&
          & base_a => p%precv(level)%base_a, base_desc=>p%precv(level)%base_desc,&
          & wv => p%precv(level)%wrk%wv(8:))
+
       if (level == nlev) then 
-        !
-        ! Apply smoother 
-        !
-        sweeps = p%precv(level)%parms%sweeps_pre
-        if (info == psb_success_) call p%precv(level)%sm%apply(done,&
-             & vx2l,dzero,vy2l,base_desc, trans,&
-             & sweeps,work,wv,info,init='Z')
-
-      else  if (level < nlev) then 
-
-        if (trans == 'N') then 
+        if (me >= 0) then 
+          !
+          ! Apply smoother 
+          !
           sweeps = p%precv(level)%parms%sweeps_pre
           if (info == psb_success_) call p%precv(level)%sm%apply(done,&
                & vx2l,dzero,vy2l,base_desc, trans,&
                & sweeps,work,wv,info,init='Z')
-        else
-          sweeps = p%precv(level)%parms%sweeps_post
-          if (info == psb_success_) call p%precv(level)%sm2%apply(done,&
-               & vx2l,dzero,vy2l,base_desc, trans,&
-               & sweeps,work,wv,info,init='Z')
         end if
+      else  if (level < nlev) then 
+        if (me >= 0) then 
 
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during 2-PRE smoother_apply')
-          goto 9999
+          if (trans == 'N') then 
+            sweeps = p%precv(level)%parms%sweeps_pre
+            if (info == psb_success_) call p%precv(level)%sm%apply(done,&
+                 & vx2l,dzero,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          else
+            sweeps = p%precv(level)%parms%sweeps_post
+            if (info == psb_success_) call p%precv(level)%sm2%apply(done,&
+                 & vx2l,dzero,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          end if
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during 2-PRE smoother_apply')
+            goto 9999
+          end if
+
+          !
+          ! Compute the residual and call recursively
+          !
+
+          call psb_geaxpby(done,vx2l,&
+               & dzero,vty,&
+               & base_desc,info)
+
+          if (info == psb_success_) call psb_spmm(-done,base_a,&
+               & vy2l,done,vty,base_desc,info,work=work,trans=trans)
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during residue')
+            goto 9999
+          end if
         end if
-
-
-        !
-        ! Compute the residual and call recursively
-        !
-
-        call psb_geaxpby(done,vx2l,&
-             & dzero,vty,&
-             & base_desc,info)
-
-        if (info == psb_success_) call psb_spmm(-done,base_a,&
-             & vy2l,done,vty,base_desc,info,work=work,trans=trans)
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during residue')
-          goto 9999
-        end if
-
         ! Apply the restriction
-        call  p%precv(level + 1)%map%map_U2V(done,vty,&
+        call  p%precv(level + 1)%map_rstr(done,vty,&
              & dzero,p%precv(level + 1)%wrk%vx2l,&
              &info,work=work,&
              & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -930,7 +943,7 @@ contains
         !
         ! Apply the prolongator
         !  
-        call p%precv(level+1)%map%map_V2U(done,&
+        call p%precv(level+1)%map_prol(done,&
              & p%precv(level+1)%wrk%vy2l,done,vy2l,&
              & info,work=work,&
              & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -940,40 +953,42 @@ contains
                & a_err='Error during prolongation')
           goto 9999
         end if
+        if (me >= 0) then 
+          !
+          ! Compute the residual
+          !
+          call psb_geaxpby(done,vx2l,&
+               & dzero,vty,base_desc,info)
+          call psb_spmm(-done,base_a,vy2l,&
+               & done,vty,base_desc,info,&
+               & work=work,trans=trans)
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during residue')
+            goto 9999
+          end if
+          !
+          ! Apply the smoother
+          !
+          if (trans == 'N') then 
+            sweeps = p%precv(level)%parms%sweeps_post
+            if (info == psb_success_) call p%precv(level)%sm2%apply(done,&
+                 & vty,done,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          else
+            sweeps = p%precv(level)%parms%sweeps_pre
+            if (info == psb_success_) call p%precv(level)%sm%apply(done,&
+                 & vty,done,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          end if
 
-        !
-        ! Compute the residual
-        !
-        call psb_geaxpby(done,vx2l,&
-             & dzero,vty,base_desc,info)
-        call psb_spmm(-done,base_a,vy2l,&
-             & done,vty,base_desc,info,&
-             & work=work,trans=trans)
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during residue')
-          goto 9999
-        end if
-        !
-        ! Apply the smoother
-        !
-        if (trans == 'N') then 
-          sweeps = p%precv(level)%parms%sweeps_post
-          if (info == psb_success_) call p%precv(level)%sm2%apply(done,&
-               & vty,done,vy2l,base_desc, trans,&
-               & sweeps,work,wv,info,init='Z')
-        else
-          sweeps = p%precv(level)%parms%sweeps_pre
-          if (info == psb_success_) call p%precv(level)%sm%apply(done,&
-               & vty,done,vy2l,base_desc, trans,&
-               & sweeps,work,wv,info,init='Z')
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during POST smoother_apply')
+            goto 9999
+          end if
         end if
 
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during POST smoother_apply')
-          goto 9999
-        end if
       else
 
         info = psb_err_internal_error_ 
@@ -990,8 +1005,7 @@ contains
     return
 
   end subroutine amg_d_inner_k_cycle
-
-
+  
   recursive subroutine amg_dinneritkcycle(p, level, trans, work, innersolv)
     use psb_base_mod
     use amg_prec_mod
@@ -1423,7 +1437,7 @@ contains
 
     if (level < nlev) then
       ! Apply the restriction
-      call p%precv(level+1)%map%map_U2V(done,mlwrk(level)%x2l,&
+      call p%precv(level+1)%map_rstr(done,mlwrk(level)%x2l,&
            & dzero,mlwrk(level+1)%x2l,&
            & info,work=work)
       mlwrk(level+1)%y2l(:) = dzero
@@ -1443,7 +1457,7 @@ contains
       !
       ! Apply the prolongator and add correction.
       !  
-      call p%precv(level+1)%map%map_V2U(done,&
+      call p%precv(level+1)%map_prol(done,&
            & mlwrk(level+1)%y2l,done,mlwrk(level)%y2l,&
            & info,work=work)
       if (info /= psb_success_) then
@@ -1564,7 +1578,7 @@ contains
                & a_err='Error during residue')
           goto 9999
         end if
-        call p%precv(level+1)%map%map_U2V(done,mlwrk(level)%ty,&
+        call p%precv(level+1)%map_rstr(done,mlwrk(level)%ty,&
              & dzero,mlwrk(level+1)%x2l,info,work=work)
         if (info /= psb_success_) then
           call psb_errpush(psb_err_internal_error_,name,&
@@ -1573,7 +1587,7 @@ contains
         end if
       else
         ! Shortcut: just transfer x2l. 
-        call p%precv(level+1)%map%map_U2V(done,mlwrk(level)%x2l,&
+        call p%precv(level+1)%map_rstr(done,mlwrk(level)%x2l,&
              & dzero,mlwrk(level+1)%x2l,info,work=work)
         if (info /= psb_success_) then
           call psb_errpush(psb_err_internal_error_,name,&
@@ -1602,7 +1616,7 @@ contains
       !
       ! Apply the prolongator
       !  
-      call p%precv(level+1)%map%map_V2U(done,mlwrk(level+1)%y2l,&
+      call p%precv(level+1)%map_prol(done,mlwrk(level+1)%y2l,&
            & done,mlwrk(level)%y2l,info,work=work)
       if (info /= psb_success_) then
         call psb_errpush(psb_err_internal_error_,name,&

amgprec/impl/amg_dprecinit.F90

@@ -127,7 +127,8 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info)
     endif
   endif
   prec%ctxt = ctxt
-  prec%ag_data%min_coarse_size = -1
+  prec%ag_data%min_coarse_size             = -1
+  prec%ag_data%min_coarse_size_per_process = -1
 
   select case(psb_toupper(trim(ptype)))
   case ('NOPREC','NONE') 

amgprec/impl/amg_s_hierarchy_bld.f90

@@ -72,9 +72,9 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
   Implicit None
 
   ! Arguments
-  type(psb_sspmat_type),intent(in), target           :: a
+  type(psb_sspmat_type),intent(in), target             :: a
   type(psb_desc_type), intent(inout), target           :: desc_a
-  class(amg_sprec_type),intent(inout),target          :: prec
+  class(amg_sprec_type),intent(inout),target           :: prec
   integer(psb_ipk_), intent(out)                       :: info
 
   ! Local Variables
@@ -82,7 +82,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
   integer(psb_ipk_)   :: me,np
   integer(psb_ipk_)   :: err,i,k, err_act, iszv, newsz,&
        & nplevs, mxplevs
-  integer(psb_lpk_) :: iaggsize, casize
+  integer(psb_lpk_) :: iaggsize, casize, mncsize, mncszpp
   real(psb_spk_)     :: mnaggratio, sizeratio, athresh, aomega
   class(amg_s_base_smoother_type), allocatable :: coarse_sm, med_sm, &
        & med_sm2, coarse_sm2
@@ -132,17 +132,24 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
   newsz      = -1
   mxplevs    = prec%ag_data%max_levs
   mnaggratio = prec%ag_data%min_cr_ratio
-  casize     = prec%ag_data%min_coarse_size
+  mncsize    = prec%ag_data%min_coarse_size
+  mncszpp    = prec%ag_data%min_coarse_size_per_process
   iszv       = size(prec%precv)
   call psb_bcast(ctxt,iszv)
-  call psb_bcast(ctxt,casize)
+  call psb_bcast(ctxt,mncsize)
+  call psb_bcast(ctxt,mncszpp)
   call psb_bcast(ctxt,mxplevs)
   call psb_bcast(ctxt,mnaggratio)
-  if (casize /= prec%ag_data%min_coarse_size) then 
+  if (mncsize /= prec%ag_data%min_coarse_size) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
     goto 9999
   end if
+  if (mncszpp /= prec%ag_data%min_coarse_size_per_process) then 
+    info=psb_err_internal_error_
+    call psb_errpush(info,name,a_err='Inconsistent min_coarse_size_per_process')
+    goto 9999
+  end if
   if (mxplevs /= prec%ag_data%max_levs) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Inconsistent max_levs')
@@ -175,7 +182,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
     !
     prec%precv(1)%base_a    => a
     prec%precv(1)%base_desc => desc_a
-  
+
     call psb_erractionrestore(err_act)
     return
   endif
@@ -192,26 +199,23 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
   !    coarse size is hit, or the gain falls below the min_cr_ratio
   !    threshold.
   !
-  
-  if (casize < 0) then
-    !
-    ! Default to the cubic root of the size at base level.
-    ! 
-    casize = desc_a%get_global_rows()
-    casize = int((sone*casize)**(sone/(sone*3)),psb_lpk_)
-    casize = max(casize,lone)
-    casize = casize*40_psb_lpk_
-    call psb_bcast(ctxt,casize)
-    if (casize > huge(prec%ag_data%min_coarse_size)) then
-      !
-      ! computed coarse size does not fit in IPK_.
-      ! This is very unlikely, but make sure to put a positive number
-      !
-      prec%ag_data%min_coarse_size = huge(prec%ag_data%min_coarse_size)
-    else
-      prec%ag_data%min_coarse_size = casize
-    end if
+  if ((mncszpp < 0).and.(mncsize<0)) then 
+    mncszpp = 200
+    prec%ag_data%min_coarse_size_per_process = mncszpp
   end if
+  if (mncszpp > 0) then
+    casize = mncszpp*np
+    if (casize > huge(ione)) casize = huge(ione)
+  else
+    if (mncsize < np) then
+      if (me == 0) write(0,*) &
+           & 'Warning: resetting coarse size to NP (1 variable per process)'
+      mncsize = np
+    end if
+    casize = mncsize
+  end if
+  prec%ag_data%target_coarse_size = casize
+  
   nplevs = max(itwo,mxplevs)
 
   !
@@ -248,7 +252,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
       end do
       deallocate(tmp_aggr,stat=info)
     end if
-            
+
     ! Then coarse
     if (info == 0) tprecv(nplevs)%parms = coarseparms
     if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info)
@@ -334,7 +338,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
     if (i==2) then 
       sizeratio = desc_a%get_global_rows()/sizeratio
     else
-      sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
+      sizeratio = sum(prec%precv(i-1)%linmap%naggr)/sizeratio
     end if
     prec%precv(i)%szratio = sizeratio
 
@@ -353,7 +357,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
         end if
       end if
 
-      if (all(nlaggr == prec%precv(i-1)%map%naggr)) then 
+      if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then 
         newsz=i-1
         if (me == 0) then 
           write(debug_unit,*) trim(name),&
@@ -369,7 +373,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
       end if
     end if
     call psb_bcast(ctxt,newsz)
-    
+
     if (newsz > 0) then
       !
       ! This is awkward, we are saving the aggregation parms, for the sake
@@ -380,7 +384,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
       if (info == 0) prec%precv(newsz)%parms = coarseparms
       prec%precv(newsz)%parms%aggr_thresh    =  athresh
       prec%precv(newsz)%parms%aggr_omega_val =  aomega 
-      
+
       if (info == 0) call restore_smoothers(prec%precv(newsz),&
            & coarse_sm,coarse_sm2,info)
       if (newsz < i) then
@@ -388,8 +392,8 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
         ! We are going back and revisit a previous leve;
         ! recover the aggregation.
         !
-        ilaggr = prec%precv(newsz)%map%iaggr
-        nlaggr = prec%precv(newsz)%map%naggr
+        ilaggr = prec%precv(newsz)%linmap%iaggr
+        nlaggr = prec%precv(newsz)%linmap%naggr
         call prec%precv(newsz)%tprol%clone(op_prol,info)
       end if
       if (do_timings) call psb_tic(idx_matasb)      
@@ -450,11 +454,36 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
     do i=2, iszv 
       prec%precv(i)%base_a       => prec%precv(i)%ac
       prec%precv(i)%base_desc    => prec%precv(i)%desc_ac
-      prec%precv(i)%map%p_desc_U => prec%precv(i-1)%base_desc
-      prec%precv(i)%map%p_desc_V => prec%precv(i)%base_desc
+      prec%precv(i)%linmap%p_desc_U => prec%precv(i-1)%base_desc
+      prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc
     end do
   end if
 
+
+  !write(0,*) 'Should we remap? '
+  if (amg_get_do_remap().and.(np>=4)) then
+    write(0,*) 'Going for remapping '
+    if (.true.) then 
+      associate(lv=>prec%precv(iszv), rmp => prec%precv(iszv)%remap_data)
+        call lv%desc_ac%clone(rmp%desc_ac_pre_remap,info)
+        call lv%ac%clone(rmp%ac_pre_remap,info)
+        if (np >= 8) then 
+          call psb_remap(np/4,rmp%desc_ac_pre_remap,rmp%ac_pre_remap,&
+               & rmp%idest,rmp%isrc,rmp%nrsrc,rmp%naggr,lv%desc_ac,lv%ac,info)
+        else
+          call psb_remap(np/2,rmp%desc_ac_pre_remap,rmp%ac_pre_remap,&
+               & rmp%idest,rmp%isrc,rmp%nrsrc,rmp%naggr,lv%desc_ac,lv%ac,info)
+        end if
+        write(0,*) me,' Out of remapping ',rmp%desc_ac_pre_remap%get_fmt(),' ',&
+             & lv%desc_ac%get_fmt(),sum(lv%linmap%naggr),sum(rmp%naggr)
+        lv%linmap%naggr(:)    =  rmp%naggr(:)
+        lv%linmap%p_desc_V => rmp%desc_ac_pre_remap
+        lv%base_a          => lv%ac
+        lv%base_desc       => lv%desc_ac
+      end associate
+    end if
+  end if
+
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_internal_error_,name,&
          & a_err='Internal hierarchy build' )
@@ -500,7 +529,7 @@ contains
       allocate(save2, mold=level%sm2a,stat=info) 
       if (info == 0) call level%sm2a%clone_settings(save2,info)
     end if
-    
+
     return
   end subroutine save_smoothers
 
@@ -519,9 +548,9 @@ contains
       if (info  == 0) allocate(level%sm,mold=save1,stat=info)
       if (info == 0) call save1%clone_settings(level%sm,info)
     end if
-    
+
     if (info /= 0) return
-    
+
     if (allocated(level%sm2a)) then
       if (info  == 0) call level%sm2a%free(info)
       if (info  == 0) deallocate(level%sm2a,stat=info)
@@ -535,6 +564,6 @@ contains
     end if
 
     return
-  end subroutine restore_smoothers    
-  
+  end subroutine restore_smoothers
+
 end subroutine amg_s_hierarchy_bld

amgprec/impl/amg_s_hierarchy_rebld.f90

@@ -127,9 +127,9 @@ subroutine amg_s_hierarchy_rebld(a,desc_a,prec,info)
   do i=2, iszv
     call prec%precv(i-1)%base_a%cp_to(acsr)
     p_desc_a => prec%precv(i-1)%base_desc
-    call prec%precv(i)%map%mat_V2U%cp_to(coo_prol)
-    call prec%precv(i)%map%mat_U2V%cp_to(coo_restr)
-    call amg_rap(acsr,p_desc_a,prec%precv(i)%map%naggr,&
+    call prec%precv(i)%linmap%mat_V2U%cp_to(coo_prol)
+    call prec%precv(i)%linmap%mat_U2V%cp_to(coo_restr)
+    call amg_rap(acsr,p_desc_a,prec%precv(i)%linmap%naggr,&
          & prec%precv(i)%parms,prec%precv(i)%ac,&
          & coo_prol,prec%precv(i)%desc_ac,coo_restr,info)
 

amgprec/impl/amg_s_smoothers_bld.f90

@@ -117,6 +117,10 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
   info = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt, me, np)
+  if (me <0) then
+!!$    write(0,*) 'out of CTXT, should not do anything '
+    goto 9998
+  end if
 
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
@@ -289,6 +293,7 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
     !
     ! build the base preconditioner at level i
     !
+!!$    write(0,*) me,' Building at level ',i
     call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
     
     if (info /= psb_success_) then 
@@ -304,6 +309,7 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Exiting with',iszv,' levels'
 
+9998 continue
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/amg_sfile_prec_descr.f90

@@ -58,17 +58,26 @@
 !             The id of the process printing the message; -1 acts as a wildcard.
 !             Default is psb_root_
 !
-subroutine amg_sfile_prec_descr(prec,iout,root)
+!
+!
+! verbosity:
+!        <0: suppress all messages
+!         0: normal
+!        >1: increased details 
+!
+subroutine amg_sfile_prec_descr(prec,iout,root, verbosity)
   use psb_base_mod
   use amg_s_prec_mod, amg_protect_name => amg_sfile_prec_descr
   use amg_s_inner_mod
   use amg_s_gs_solver
-  
+
   implicit none 
   ! Arguments
   class(amg_sprec_type), intent(in)      :: prec
   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
@@ -76,8 +85,7 @@ subroutine amg_sfile_prec_descr(prec,iout,root)
   integer(psb_ipk_)   :: me, np
   logical             :: is_symgs
   character(len=20), parameter :: name='amg_file_prec_descr'
-  integer(psb_ipk_)  :: iout_
-  integer(psb_ipk_)  :: root_
+  integer(psb_ipk_)  :: iout_, root_, verbosity_
 
   info = psb_success_
   if (present(iout)) then 
@@ -86,6 +94,12 @@ subroutine amg_sfile_prec_descr(prec,iout,root)
     iout_ = psb_out_unit
   end if
   if (iout_ < 0) iout_ = psb_out_unit
+  if (present(verbosity)) then
+    verbosity_ = verbosity
+  else
+    verbosity_ = 0
+  end if
+  if (verbosity_ < 0) goto 9998
 
   ctxt = prec%ctxt
 
@@ -99,102 +113,104 @@ subroutine amg_sfile_prec_descr(prec,iout,root)
     end if
     if (root_ == -1) root_ = me
 
-    !
-    ! The preconditioner description is printed by processor psb_root_.
-    ! This agrees with the fact that all the parameters defining the
-    ! preconditioner have the same values on all the procs (this is
-    ! ensured by amg_precbld).
-    !
-    if (me == root_) then
-      nlev = size(prec%precv)
-      do ilev = 1, nlev 
-        if (.not.allocated(prec%precv(ilev)%sm)) then 
-          info = 3111
-          write(iout_,*) ' ',name,&
-               & ': error: inconsistent MLPREC part, should call amg_PRECINIT'
-          return
-        endif
-      end do
+    if (verbosity_ >=0) then 
+      !
+      ! The preconditioner description is printed by processor psb_root_.
+      ! This agrees with the fact that all the parameters defining the
+      ! preconditioner have the same values on all the procs (this is
+      ! ensured by amg_precbld).
+      !
+      if (me == root_) then
+        nlev = size(prec%precv)
+        do ilev = 1, nlev 
+          if (.not.allocated(prec%precv(ilev)%sm)) then 
+            info = 3111
+            write(iout_,*) ' ',name,&
+                 & ': error: inconsistent MLPREC part, should call amg_PRECINIT'
+            return
+          endif
+        end do
 
-      write(iout_,*) 
-      write(iout_,'(a)') 'Preconditioner description'
+        write(iout_,*) 
+        write(iout_,'(a)') 'Preconditioner description'
 
-      if (nlev == 1) then
-        !
-        ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel.
-        ! Will need rethinking...
-        !
-        if (allocated(prec%precv(1)%sm2a)) then
-          is_symgs = .false.
-          select type(sv2 => prec%precv(1)%sm2a%sv)
-          class is (amg_s_bwgs_solver_type)
-            select type(sv1 => prec%precv(1)%sm%sv)
-            class is (amg_s_gs_solver_type)
-              is_symgs = .true.
+        if (nlev == 1) then
+          !
+          ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel.
+          ! Will need rethinking...
+          !
+          if (allocated(prec%precv(1)%sm2a)) then
+            is_symgs = .false.
+            select type(sv2 => prec%precv(1)%sm2a%sv)
+            class is (amg_s_bwgs_solver_type)
+              select type(sv1 => prec%precv(1)%sm%sv)
+              class is (amg_s_gs_solver_type)
+                is_symgs = .true.
+              end select
             end select
-          end select
-          if (is_symgs) then
-            write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel'
+            if (is_symgs) then
+              write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel'
+            else
+              write(iout_,*) 'Pre Smoother: '
+              call prec%precv(1)%sm%descr(info,iout=iout_)
+              write(iout_,*) 'Post smoother:'
+              call prec%precv(1)%sm2a%descr(info,iout=iout_)
+            end if
+            nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post)
+
           else
+            call prec%precv(1)%sm%descr(info,iout=iout_)
+            nswps = prec%precv(1)%parms%sweeps_pre
+          end if
+          if (nswps > 1)  write(iout_,*) '  Number of  sweeps : ',nswps
+          write(iout_,*) 
+
+        else if (nlev > 1) then
+          !
+          ! Print description of base preconditioner
+          !
+          write(iout_,*) 'Multilevel Preconditioner'
+          write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
+          write(iout_,*) 
+          if (allocated(prec%precv(1)%sm2a)) then
             write(iout_,*) 'Pre Smoother: '
             call prec%precv(1)%sm%descr(info,iout=iout_)
             write(iout_,*) 'Post smoother:'
             call prec%precv(1)%sm2a%descr(info,iout=iout_)
+          else
+            write(iout_,*) 'Smoother: '
+            call prec%precv(1)%sm%descr(info,iout=iout_)
           end if
-          nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post)
+          !
+          ! Print multilevel details
+          !
+          write(iout_,*) 
+          write(iout_,*) 'Multilevel hierarchy: '
+          write(iout_,*) ' Number of levels   : ',nlev
+          write(iout_,*) ' Operator complexity: ',prec%get_complexity()
+          write(iout_,*) ' Average coarsening : ',prec%get_avg_cr()
+          ilmin = 2
+          if (nlev == 2) ilmin=1
+          do ilev=ilmin,nlev
+            call prec%precv(ilev)%descr(ilev,nlev,ilmin,info, &
+                 & iout=iout_,verbosity=verbosity)
+          end do
+          write(iout_,*) 
 
         else
-          call prec%precv(1)%sm%descr(info,iout=iout_)
-          nswps = prec%precv(1)%parms%sweeps_pre
+          write(iout_,*) trim(name), &
+               & ': invalid preconditioner array size ?',nlev
+          info = -2
+          return
+
         end if
-        if (nswps > 1)  write(iout_,*) '  Number of  sweeps : ',nswps
-        write(iout_,*) 
-
-      else if (nlev > 1) then
-        !
-        ! Print description of base preconditioner
-        !
-        write(iout_,*) 'Multilevel Preconditioner'
-        write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
-        write(iout_,*) 
-        if (allocated(prec%precv(1)%sm2a)) then
-          write(iout_,*) 'Pre Smoother: '
-          call prec%precv(1)%sm%descr(info,iout=iout_)
-          write(iout_,*) 'Post smoother:'
-          call prec%precv(1)%sm2a%descr(info,iout=iout_)
-        else
-          write(iout_,*) 'Smoother: '
-          call prec%precv(1)%sm%descr(info,iout=iout_)
-        end if
-        !
-        ! Print multilevel details
-        !
-        write(iout_,*) 
-        write(iout_,*) 'Multilevel hierarchy: '
-        write(iout_,*) ' Number of levels   : ',nlev
-        write(iout_,*) ' Operator complexity: ',prec%get_complexity()
-        write(iout_,*) ' Average coarsening : ',prec%get_avg_cr()
-        ilmin = 2
-        if (nlev == 2) ilmin=1
-        do ilev=ilmin,nlev
-          call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
-        end do
-        write(iout_,*) 
-
-      else
-        write(iout_,*) trim(name), &
-             & ': invalid preconditioner array size ?',nlev
-        info = -2
-        return
-
       end if
     end if
-
   else
     write(iout_,*) trim(name), &
          & ': Error: no base preconditioner available, something is wrong!'
     info = -2
     return
   endif
-
+9998 continue
 end subroutine amg_sfile_prec_descr

amgprec/impl/amg_smlprec_aply.f90

@@ -393,38 +393,39 @@ contains
     if(debug_level > 1) then
       write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
     end if
-
-    select case(p%precv(level)%parms%ml_cycle) 
-
-    case(amg_no_ml_)
-      !
-      ! No preconditioning, should not really get here
-      ! 
-      call psb_errpush(psb_err_internal_error_,name,&
-           & a_err='amg_no_ml_ in mlprc_aply?')
-      goto 9999      
-
-    case(amg_add_ml_)
-
-      call amg_s_inner_add(p, level, trans, work)
-
-    case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
-
-      call amg_s_inner_mult(p, level, trans, work)
-      
-    case(amg_kcycle_ml_, amg_kcyclesym_ml_)
-
-      call amg_s_inner_k_cycle(p, level, trans, work)
-      
-    case default
-      info = psb_err_from_subroutine_ai_
-      call psb_errpush(info,name,a_err='invalid ml_cycle',&
-           &  i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
-      goto 9999      
-
-    end select
-    if(debug_level > 1) then
-      write(debug_unit,*) me,' End inner_ml_aply at level ',level
+    if (me >= 0) then
+      select case(p%precv(level)%parms%ml_cycle) 
+        
+      case(amg_no_ml_)
+        !
+        ! No preconditioning, should not really get here
+        ! 
+        call psb_errpush(psb_err_internal_error_,name,&
+             & a_err='amg_no_ml_ in mlprc_aply?')
+        goto 9999      
+        
+      case(amg_add_ml_)
+        
+        call amg_s_inner_add(p, level, trans, work)
+        
+      case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
+        
+        call amg_s_inner_mult(p, level, trans, work)
+        
+      case(amg_kcycle_ml_, amg_kcyclesym_ml_)
+        
+        call amg_s_inner_k_cycle(p, level, trans, work)
+        
+      case default
+        info = psb_err_from_subroutine_ai_
+        call psb_errpush(info,name,a_err='invalid ml_cycle',&
+             &  i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
+        goto 9999      
+        
+      end select
+      if(debug_level > 1) then
+        write(debug_unit,*) me,' End inner_ml_aply at level ',level
+      end if
     end if
 
     call psb_erractionrestore(err_act)
@@ -492,28 +493,30 @@ contains
          & base_a => p%precv(level)%base_a, base_desc=>p%precv(level)%base_desc,&
          & wv => p%precv(level)%wrk%wv)
 
-      if (allocated(p%precv(level)%sm2a)) then
-        call psb_geaxpby(sone,vx2l,szero,vy2l,base_desc,info)
-
-        sweeps = max(p%precv(level)%parms%sweeps_pre,p%precv(level)%parms%sweeps_post)
-        do k=1, sweeps
+      if (me >= 0) then 
+        if (allocated(p%precv(level)%sm2a)) then
+          call psb_geaxpby(sone,vx2l,szero,vy2l,base_desc,info)
+          
+          sweeps = max(p%precv(level)%parms%sweeps_pre,p%precv(level)%parms%sweeps_post)
+          do k=1, sweeps
+            call p%precv(level)%sm%apply(sone,&
+                 & vy2l,szero,vty,&
+                 & base_desc, trans,&
+                 & ione,work,wv,info,init='Z')
+            
+            call p%precv(level)%sm2a%apply(sone,&
+                 & vty,szero,vy2l,&
+                 & base_desc, trans,&
+                 & ione,work,wv,info,init='Z')        
+          end do
+          
+        else
+          sweeps = p%precv(level)%parms%sweeps_pre
           call p%precv(level)%sm%apply(sone,&
-               & vy2l,szero,vty,&
+               & vx2l,szero,vy2l,&
                & base_desc, trans,&
-               & ione,work,wv,info,init='Z')
-
-          call p%precv(level)%sm2a%apply(sone,&
-               & vty,szero,vy2l,&
-               & base_desc, trans,&
-               & ione,work,wv,info,init='Z')        
-        end do
-
-      else
-        sweeps = p%precv(level)%parms%sweeps_pre
-        call p%precv(level)%sm%apply(sone,&
-             & vx2l,szero,vy2l,&
-             & base_desc, trans,&
-             & sweeps,work,wv,info,init='Z')
+               & sweeps,work,wv,info,init='Z')
+        end if
       end if
       if (info /= psb_success_) then
         call psb_errpush(psb_err_internal_error_,name,&
@@ -523,7 +526,7 @@ contains
 
       if (level < nlev) then
         ! Apply the restriction
-        call p%precv(level+1)%map%map_U2V(sone,vx2l,&
+        call p%precv(level+1)%map_rstr(sone,vx2l,&
              & szero,p%precv(level+1)%wrk%vx2l,&
              & info,work=work,&
              & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -543,7 +546,7 @@ contains
         !
         ! Apply the prolongator
         !  
-        call p%precv(level+1)%map%map_V2U(sone,&
+        call p%precv(level+1)%map_prol(sone,&
              & p%precv(level+1)%wrk%vy2l, sone,vy2l,&
              & info,work=work,&
              & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -602,7 +605,6 @@ contains
     end if
     ctxt = p%precv(level)%base_desc%get_context()
     call psb_info(ctxt, me, np)
-
     if(debug_level > 1) then
       write(debug_unit,*) me,' inner_mult at level ',level
     end if
@@ -623,22 +625,25 @@ contains
         !
 
         if (pre) then
-          if (trans == 'N') then 
-            sweeps = p%precv(level)%parms%sweeps_pre
-            if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
-                 & vx2l,szero,vy2l,base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
-          else
-            sweeps = p%precv(level)%parms%sweeps_post
-            if (info == psb_success_) call p%precv(level)%sm2%apply(sone,&
-                 & vx2l,szero,vy2l, base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
-          end if
-
-          if (info /= psb_success_) then
-            call psb_errpush(psb_err_internal_error_,name,&
-                 & a_err='Error during PRE smoother_apply')
-            goto 9999
+          if (me >=0) then
+!!$            write(0,*) me,'Applying smoother pre ', level
+            if (trans == 'N') then 
+              sweeps = p%precv(level)%parms%sweeps_pre
+              if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
+                   & vx2l,szero,vy2l,base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            else
+              sweeps = p%precv(level)%parms%sweeps_post
+              if (info == psb_success_) call p%precv(level)%sm2%apply(sone,&
+                   & vx2l,szero,vy2l, base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            end if
+            
+            if (info /= psb_success_) then
+              call psb_errpush(psb_err_internal_error_,name,&
+                   & a_err='Error during PRE smoother_apply')
+              goto 9999
+            end if
           end if
         endif
         !
@@ -657,7 +662,7 @@ contains
                  & a_err='Error during residue')
             goto 9999
           end if
-          call p%precv(level+1)%map%map_U2V(sone,vty,&
+          call p%precv(level+1)%map_rstr(sone,vty,&
                & szero,p%precv(level+1)%wrk%vx2l,&
                & info,work=work,&
                & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -668,7 +673,7 @@ contains
           end if
         else
           ! Shortcut: just transfer x2l. 
-          call p%precv(level+1)%map%map_U2V(sone,vx2l,&
+          call p%precv(level+1)%map_rstr(sone,vx2l,&
                & szero,p%precv(level+1)%wrk%vx2l,&
                & info,work=work,&
                & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -684,7 +689,7 @@ contains
         !
         ! Apply the prolongator
         !  
-        call p%precv(level+1)%map%map_V2U(sone,&
+        call p%precv(level+1)%map_prol(sone,&
              & p%precv(level+1)%wrk%vy2l,sone,vy2l,&
              & info,work=work,&
              & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -696,13 +701,15 @@ contains
 
         if (p%precv(level)%parms%ml_cycle == amg_wcycle_ml_) then
 
-          call psb_geaxpby(sone,vx2l, szero,vty,&
-               & base_desc,info)        
-          if (info == psb_success_) call psb_spmm(-sone,base_a,&
-               & vy2l,sone,vty,&
-               & base_desc,info,work=work,trans=trans)
+          if (me >=0) then 
+            call psb_geaxpby(sone,vx2l, szero,vty,&
+                 & base_desc,info)        
+            if (info == psb_success_) call psb_spmm(-sone,base_a,&
+                 & vy2l,sone,vty,&
+                 & base_desc,info,work=work,trans=trans)
+          end if
           if (info == psb_success_) &
-               & call p%precv(level+1)%map%map_U2V(sone,vty,&
+               & call p%precv(level+1)%map_rstr(sone,vty,&
                & szero,p%precv(level+1)%wrk%vx2l,info,work=work,&
                & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
           if (info /= psb_success_) then
@@ -713,7 +720,7 @@ contains
 
           call inner_ml_aply(level+1,p,trans,work,info)
 
-          if (info == psb_success_) call p%precv(level+1)%map%map_V2U(sone, &
+          if (info == psb_success_) call p%precv(level+1)%map_prol(sone, &
                & p%precv(level+1)%wrk%vy2l,sone,vy2l,&
                & info,work=work,&
                & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -728,31 +735,33 @@ contains
 
 
         if (post) then
-          call psb_geaxpby(sone,vx2l,&
-               & szero,vty,&
-               & base_desc,info)
-          if (info == psb_success_) call psb_spmm(-sone,base_a,&
-               & vy2l, sone,vty,base_desc,info,&
-               & work=work,trans=trans)
-          if (info /= psb_success_) then
-            call psb_errpush(psb_err_internal_error_,name,&
-                 & a_err='Error during residue')
-            goto 9999
-          end if
-
-          !
-          ! Apply the second smoother
-          !
-          if (trans == 'N') then
-            sweeps = p%precv(level)%parms%sweeps_post
-            if (info == psb_success_) call p%precv(level)%sm2%apply(sone,&
-                 & vty,sone,vy2l, base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
-          else 
-            sweeps = p%precv(level)%parms%sweeps_pre
-            if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
-                 & vty,sone,vy2l, base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
+          if (me >=0) then 
+            call psb_geaxpby(sone,vx2l,&
+                 & szero,vty,&
+                 & base_desc,info)
+            if (info == psb_success_) call psb_spmm(-sone,base_a,&
+                 & vy2l, sone,vty,base_desc,info,&
+                 & work=work,trans=trans)
+            if (info /= psb_success_) then
+              call psb_errpush(psb_err_internal_error_,name,&
+                   & a_err='Error during residue')
+              goto 9999
+            end if
+            
+            !
+            ! Apply the second smoother
+            !
+            if (trans == 'N') then
+              sweeps = p%precv(level)%parms%sweeps_post
+              if (info == psb_success_) call p%precv(level)%sm2%apply(sone,&
+                   & vty,sone,vy2l, base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            else 
+              sweeps = p%precv(level)%parms%sweeps_pre
+              if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
+                   & vty,sone,vy2l, base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            end if
           end if
 
           if (info /= psb_success_) then
@@ -764,11 +773,14 @@ contains
         endif
 
       else if (level == nlev) then
-
-        sweeps = p%precv(level)%parms%sweeps_pre
-        if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
-             & vx2l,szero,vy2l,base_desc, trans,&
-             & sweeps,work,wv,info)
+!!$        write(0,*) me,'Applying smoother at top level ',psb_errstatus_fatal()
+        if (me >=0) then 
+          sweeps = p%precv(level)%parms%sweeps_pre
+          if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
+               & vx2l,szero,vy2l,base_desc, trans,&
+               & sweeps,work,wv,info)
+        end if 
+!!$        write(0,*) me,' Done applying smoother at top level ',psb_errstatus_fatal()
 
       else
 
@@ -778,7 +790,7 @@ contains
         goto 9999
       end if
     end associate
-    
+9998 continue
     call psb_erractionrestore(err_act)
     return
 
@@ -829,72 +841,73 @@ contains
     end if
     ctxt = p%precv(level)%base_desc%get_context()
     call psb_info(ctxt, me, np)
-
+    
     if(debug_level > 1) then
       write(debug_unit,*) me,name,' start at level ',level
     end if
-
+    
     if ((level<1).or.(level>nlev)) then
       info = psb_err_internal_error_ 
       call psb_errpush(info,name,&
            & a_err='Invalid LEVEL>NLEV')
       goto 9999
     end if
-
+    
     !K cycle
     
     associate(vx2l => p%precv(level)%wrk%vx2l,vy2l => p%precv(level)%wrk%vy2l,&
          & vtx => p%precv(level)%wrk%vtx,vty => p%precv(level)%wrk%vty,&
          & base_a => p%precv(level)%base_a, base_desc=>p%precv(level)%base_desc,&
          & wv => p%precv(level)%wrk%wv(8:))
+
       if (level == nlev) then 
-        !
-        ! Apply smoother 
-        !
-        sweeps = p%precv(level)%parms%sweeps_pre
-        if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
-             & vx2l,szero,vy2l,base_desc, trans,&
-             & sweeps,work,wv,info,init='Z')
-
-      else  if (level < nlev) then 
-
-        if (trans == 'N') then 
+        if (me >= 0) then 
+          !
+          ! Apply smoother 
+          !
           sweeps = p%precv(level)%parms%sweeps_pre
           if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
                & vx2l,szero,vy2l,base_desc, trans,&
                & sweeps,work,wv,info,init='Z')
-        else
-          sweeps = p%precv(level)%parms%sweeps_post
-          if (info == psb_success_) call p%precv(level)%sm2%apply(sone,&
-               & vx2l,szero,vy2l,base_desc, trans,&
-               & sweeps,work,wv,info,init='Z')
         end if
+      else  if (level < nlev) then 
+        if (me >= 0) then 
 
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during 2-PRE smoother_apply')
-          goto 9999
+          if (trans == 'N') then 
+            sweeps = p%precv(level)%parms%sweeps_pre
+            if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
+                 & vx2l,szero,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          else
+            sweeps = p%precv(level)%parms%sweeps_post
+            if (info == psb_success_) call p%precv(level)%sm2%apply(sone,&
+                 & vx2l,szero,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          end if
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during 2-PRE smoother_apply')
+            goto 9999
+          end if
+
+          !
+          ! Compute the residual and call recursively
+          !
+
+          call psb_geaxpby(sone,vx2l,&
+               & szero,vty,&
+               & base_desc,info)
+
+          if (info == psb_success_) call psb_spmm(-sone,base_a,&
+               & vy2l,sone,vty,base_desc,info,work=work,trans=trans)
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during residue')
+            goto 9999
+          end if
         end if
-
-
-        !
-        ! Compute the residual and call recursively
-        !
-
-        call psb_geaxpby(sone,vx2l,&
-             & szero,vty,&
-             & base_desc,info)
-
-        if (info == psb_success_) call psb_spmm(-sone,base_a,&
-             & vy2l,sone,vty,base_desc,info,work=work,trans=trans)
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during residue')
-          goto 9999
-        end if
-
         ! Apply the restriction
-        call  p%precv(level + 1)%map%map_U2V(sone,vty,&
+        call  p%precv(level + 1)%map_rstr(sone,vty,&
              & szero,p%precv(level + 1)%wrk%vx2l,&
              &info,work=work,&
              & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -930,7 +943,7 @@ contains
         !
         ! Apply the prolongator
         !  
-        call p%precv(level+1)%map%map_V2U(sone,&
+        call p%precv(level+1)%map_prol(sone,&
              & p%precv(level+1)%wrk%vy2l,sone,vy2l,&
              & info,work=work,&
              & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -940,40 +953,42 @@ contains
                & a_err='Error during prolongation')
           goto 9999
         end if
+        if (me >= 0) then 
+          !
+          ! Compute the residual
+          !
+          call psb_geaxpby(sone,vx2l,&
+               & szero,vty,base_desc,info)
+          call psb_spmm(-sone,base_a,vy2l,&
+               & sone,vty,base_desc,info,&
+               & work=work,trans=trans)
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during residue')
+            goto 9999
+          end if
+          !
+          ! Apply the smoother
+          !
+          if (trans == 'N') then 
+            sweeps = p%precv(level)%parms%sweeps_post
+            if (info == psb_success_) call p%precv(level)%sm2%apply(sone,&
+                 & vty,sone,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          else
+            sweeps = p%precv(level)%parms%sweeps_pre
+            if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
+                 & vty,sone,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          end if
 
-        !
-        ! Compute the residual
-        !
-        call psb_geaxpby(sone,vx2l,&
-             & szero,vty,base_desc,info)
-        call psb_spmm(-sone,base_a,vy2l,&
-             & sone,vty,base_desc,info,&
-             & work=work,trans=trans)
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during residue')
-          goto 9999
-        end if
-        !
-        ! Apply the smoother
-        !
-        if (trans == 'N') then 
-          sweeps = p%precv(level)%parms%sweeps_post
-          if (info == psb_success_) call p%precv(level)%sm2%apply(sone,&
-               & vty,sone,vy2l,base_desc, trans,&
-               & sweeps,work,wv,info,init='Z')
-        else
-          sweeps = p%precv(level)%parms%sweeps_pre
-          if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
-               & vty,sone,vy2l,base_desc, trans,&
-               & sweeps,work,wv,info,init='Z')
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during POST smoother_apply')
+            goto 9999
+          end if
         end if
 
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during POST smoother_apply')
-          goto 9999
-        end if
       else
 
         info = psb_err_internal_error_ 
@@ -990,8 +1005,7 @@ contains
     return
 
   end subroutine amg_s_inner_k_cycle
-
-
+  
   recursive subroutine amg_sinneritkcycle(p, level, trans, work, innersolv)
     use psb_base_mod
     use amg_prec_mod
@@ -1423,7 +1437,7 @@ contains
 
     if (level < nlev) then
       ! Apply the restriction
-      call p%precv(level+1)%map%map_U2V(sone,mlwrk(level)%x2l,&
+      call p%precv(level+1)%map_rstr(sone,mlwrk(level)%x2l,&
            & szero,mlwrk(level+1)%x2l,&
            & info,work=work)
       mlwrk(level+1)%y2l(:) = szero
@@ -1443,7 +1457,7 @@ contains
       !
       ! Apply the prolongator and add correction.
       !  
-      call p%precv(level+1)%map%map_V2U(sone,&
+      call p%precv(level+1)%map_prol(sone,&
            & mlwrk(level+1)%y2l,sone,mlwrk(level)%y2l,&
            & info,work=work)
       if (info /= psb_success_) then
@@ -1564,7 +1578,7 @@ contains
                & a_err='Error during residue')
           goto 9999
         end if
-        call p%precv(level+1)%map%map_U2V(sone,mlwrk(level)%ty,&
+        call p%precv(level+1)%map_rstr(sone,mlwrk(level)%ty,&
              & szero,mlwrk(level+1)%x2l,info,work=work)
         if (info /= psb_success_) then
           call psb_errpush(psb_err_internal_error_,name,&
@@ -1573,7 +1587,7 @@ contains
         end if
       else
         ! Shortcut: just transfer x2l. 
-        call p%precv(level+1)%map%map_U2V(sone,mlwrk(level)%x2l,&
+        call p%precv(level+1)%map_rstr(sone,mlwrk(level)%x2l,&
              & szero,mlwrk(level+1)%x2l,info,work=work)
         if (info /= psb_success_) then
           call psb_errpush(psb_err_internal_error_,name,&
@@ -1602,7 +1616,7 @@ contains
       !
       ! Apply the prolongator
       !  
-      call p%precv(level+1)%map%map_V2U(sone,mlwrk(level+1)%y2l,&
+      call p%precv(level+1)%map_prol(sone,mlwrk(level+1)%y2l,&
            & sone,mlwrk(level)%y2l,info,work=work)
       if (info /= psb_success_) then
         call psb_errpush(psb_err_internal_error_,name,&

amgprec/impl/amg_sprecinit.F90

@@ -124,7 +124,8 @@ subroutine amg_sprecinit(ctxt,prec,ptype,info)
     endif
   endif
   prec%ctxt = ctxt
-  prec%ag_data%min_coarse_size = -1
+  prec%ag_data%min_coarse_size             = -1
+  prec%ag_data%min_coarse_size_per_process = -1
 
   select case(psb_toupper(trim(ptype)))
   case ('NOPREC','NONE') 

amgprec/impl/amg_z_hierarchy_bld.f90

@@ -72,9 +72,9 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
   Implicit None
 
   ! Arguments
-  type(psb_zspmat_type),intent(in), target           :: a
+  type(psb_zspmat_type),intent(in), target             :: a
   type(psb_desc_type), intent(inout), target           :: desc_a
-  class(amg_zprec_type),intent(inout),target          :: prec
+  class(amg_zprec_type),intent(inout),target           :: prec
   integer(psb_ipk_), intent(out)                       :: info
 
   ! Local Variables
@@ -82,7 +82,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
   integer(psb_ipk_)   :: me,np
   integer(psb_ipk_)   :: err,i,k, err_act, iszv, newsz,&
        & nplevs, mxplevs
-  integer(psb_lpk_) :: iaggsize, casize
+  integer(psb_lpk_) :: iaggsize, casize, mncsize, mncszpp
   real(psb_dpk_)     :: mnaggratio, sizeratio, athresh, aomega
   class(amg_z_base_smoother_type), allocatable :: coarse_sm, med_sm, &
        & med_sm2, coarse_sm2
@@ -132,17 +132,24 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
   newsz      = -1
   mxplevs    = prec%ag_data%max_levs
   mnaggratio = prec%ag_data%min_cr_ratio
-  casize     = prec%ag_data%min_coarse_size
+  mncsize    = prec%ag_data%min_coarse_size
+  mncszpp    = prec%ag_data%min_coarse_size_per_process
   iszv       = size(prec%precv)
   call psb_bcast(ctxt,iszv)
-  call psb_bcast(ctxt,casize)
+  call psb_bcast(ctxt,mncsize)
+  call psb_bcast(ctxt,mncszpp)
   call psb_bcast(ctxt,mxplevs)
   call psb_bcast(ctxt,mnaggratio)
-  if (casize /= prec%ag_data%min_coarse_size) then 
+  if (mncsize /= prec%ag_data%min_coarse_size) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
     goto 9999
   end if
+  if (mncszpp /= prec%ag_data%min_coarse_size_per_process) then 
+    info=psb_err_internal_error_
+    call psb_errpush(info,name,a_err='Inconsistent min_coarse_size_per_process')
+    goto 9999
+  end if
   if (mxplevs /= prec%ag_data%max_levs) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Inconsistent max_levs')
@@ -175,7 +182,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
     !
     prec%precv(1)%base_a    => a
     prec%precv(1)%base_desc => desc_a
-  
+
     call psb_erractionrestore(err_act)
     return
   endif
@@ -192,26 +199,23 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
   !    coarse size is hit, or the gain falls below the min_cr_ratio
   !    threshold.
   !
-  
-  if (casize < 0) then
-    !
-    ! Default to the cubic root of the size at base level.
-    ! 
-    casize = desc_a%get_global_rows()
-    casize = int((done*casize)**(done/(done*3)),psb_lpk_)
-    casize = max(casize,lone)
-    casize = casize*40_psb_lpk_
-    call psb_bcast(ctxt,casize)
-    if (casize > huge(prec%ag_data%min_coarse_size)) then
-      !
-      ! computed coarse size does not fit in IPK_.
-      ! This is very unlikely, but make sure to put a positive number
-      !
-      prec%ag_data%min_coarse_size = huge(prec%ag_data%min_coarse_size)
-    else
-      prec%ag_data%min_coarse_size = casize
-    end if
+  if ((mncszpp < 0).and.(mncsize<0)) then 
+    mncszpp = 200
+    prec%ag_data%min_coarse_size_per_process = mncszpp
   end if
+  if (mncszpp > 0) then
+    casize = mncszpp*np
+    if (casize > huge(ione)) casize = huge(ione)
+  else
+    if (mncsize < np) then
+      if (me == 0) write(0,*) &
+           & 'Warning: resetting coarse size to NP (1 variable per process)'
+      mncsize = np
+    end if
+    casize = mncsize
+  end if
+  prec%ag_data%target_coarse_size = casize
+  
   nplevs = max(itwo,mxplevs)
 
   !
@@ -248,7 +252,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
       end do
       deallocate(tmp_aggr,stat=info)
     end if
-            
+
     ! Then coarse
     if (info == 0) tprecv(nplevs)%parms = coarseparms
     if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info)
@@ -334,7 +338,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
     if (i==2) then 
       sizeratio = desc_a%get_global_rows()/sizeratio
     else
-      sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
+      sizeratio = sum(prec%precv(i-1)%linmap%naggr)/sizeratio
     end if
     prec%precv(i)%szratio = sizeratio
 
@@ -353,7 +357,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
         end if
       end if
 
-      if (all(nlaggr == prec%precv(i-1)%map%naggr)) then 
+      if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then 
         newsz=i-1
         if (me == 0) then 
           write(debug_unit,*) trim(name),&
@@ -369,7 +373,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
       end if
     end if
     call psb_bcast(ctxt,newsz)
-    
+
     if (newsz > 0) then
       !
       ! This is awkward, we are saving the aggregation parms, for the sake
@@ -380,7 +384,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
       if (info == 0) prec%precv(newsz)%parms = coarseparms
       prec%precv(newsz)%parms%aggr_thresh    =  athresh
       prec%precv(newsz)%parms%aggr_omega_val =  aomega 
-      
+
       if (info == 0) call restore_smoothers(prec%precv(newsz),&
            & coarse_sm,coarse_sm2,info)
       if (newsz < i) then
@@ -388,8 +392,8 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
         ! We are going back and revisit a previous leve;
         ! recover the aggregation.
         !
-        ilaggr = prec%precv(newsz)%map%iaggr
-        nlaggr = prec%precv(newsz)%map%naggr
+        ilaggr = prec%precv(newsz)%linmap%iaggr
+        nlaggr = prec%precv(newsz)%linmap%naggr
         call prec%precv(newsz)%tprol%clone(op_prol,info)
       end if
       if (do_timings) call psb_tic(idx_matasb)      
@@ -450,11 +454,36 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
     do i=2, iszv 
       prec%precv(i)%base_a       => prec%precv(i)%ac
       prec%precv(i)%base_desc    => prec%precv(i)%desc_ac
-      prec%precv(i)%map%p_desc_U => prec%precv(i-1)%base_desc
-      prec%precv(i)%map%p_desc_V => prec%precv(i)%base_desc
+      prec%precv(i)%linmap%p_desc_U => prec%precv(i-1)%base_desc
+      prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc
     end do
   end if
 
+
+  !write(0,*) 'Should we remap? '
+  if (amg_get_do_remap().and.(np>=4)) then
+    write(0,*) 'Going for remapping '
+    if (.true.) then 
+      associate(lv=>prec%precv(iszv), rmp => prec%precv(iszv)%remap_data)
+        call lv%desc_ac%clone(rmp%desc_ac_pre_remap,info)
+        call lv%ac%clone(rmp%ac_pre_remap,info)
+        if (np >= 8) then 
+          call psb_remap(np/4,rmp%desc_ac_pre_remap,rmp%ac_pre_remap,&
+               & rmp%idest,rmp%isrc,rmp%nrsrc,rmp%naggr,lv%desc_ac,lv%ac,info)
+        else
+          call psb_remap(np/2,rmp%desc_ac_pre_remap,rmp%ac_pre_remap,&
+               & rmp%idest,rmp%isrc,rmp%nrsrc,rmp%naggr,lv%desc_ac,lv%ac,info)
+        end if
+        write(0,*) me,' Out of remapping ',rmp%desc_ac_pre_remap%get_fmt(),' ',&
+             & lv%desc_ac%get_fmt(),sum(lv%linmap%naggr),sum(rmp%naggr)
+        lv%linmap%naggr(:)    =  rmp%naggr(:)
+        lv%linmap%p_desc_V => rmp%desc_ac_pre_remap
+        lv%base_a          => lv%ac
+        lv%base_desc       => lv%desc_ac
+      end associate
+    end if
+  end if
+
   if (info /= psb_success_) then 
     call psb_errpush(psb_err_internal_error_,name,&
          & a_err='Internal hierarchy build' )
@@ -500,7 +529,7 @@ contains
       allocate(save2, mold=level%sm2a,stat=info) 
       if (info == 0) call level%sm2a%clone_settings(save2,info)
     end if
-    
+
     return
   end subroutine save_smoothers
 
@@ -519,9 +548,9 @@ contains
       if (info  == 0) allocate(level%sm,mold=save1,stat=info)
       if (info == 0) call save1%clone_settings(level%sm,info)
     end if
-    
+
     if (info /= 0) return
-    
+
     if (allocated(level%sm2a)) then
       if (info  == 0) call level%sm2a%free(info)
       if (info  == 0) deallocate(level%sm2a,stat=info)
@@ -535,6 +564,6 @@ contains
     end if
 
     return
-  end subroutine restore_smoothers    
-  
+  end subroutine restore_smoothers
+
 end subroutine amg_z_hierarchy_bld

amgprec/impl/amg_z_hierarchy_rebld.f90

@@ -127,9 +127,9 @@ subroutine amg_z_hierarchy_rebld(a,desc_a,prec,info)
   do i=2, iszv
     call prec%precv(i-1)%base_a%cp_to(acsr)
     p_desc_a => prec%precv(i-1)%base_desc
-    call prec%precv(i)%map%mat_V2U%cp_to(coo_prol)
-    call prec%precv(i)%map%mat_U2V%cp_to(coo_restr)
-    call amg_rap(acsr,p_desc_a,prec%precv(i)%map%naggr,&
+    call prec%precv(i)%linmap%mat_V2U%cp_to(coo_prol)
+    call prec%precv(i)%linmap%mat_U2V%cp_to(coo_restr)
+    call amg_rap(acsr,p_desc_a,prec%precv(i)%linmap%naggr,&
          & prec%precv(i)%parms,prec%precv(i)%ac,&
          & coo_prol,prec%precv(i)%desc_ac,coo_restr,info)
 

amgprec/impl/amg_z_smoothers_bld.f90

@@ -117,6 +117,10 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
   info = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt, me, np)
+  if (me <0) then
+!!$    write(0,*) 'out of CTXT, should not do anything '
+    goto 9998
+  end if
 
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
@@ -289,6 +293,7 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
     !
     ! build the base preconditioner at level i
     !
+!!$    write(0,*) me,' Building at level ',i
     call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
     
     if (info /= psb_success_) then 
@@ -304,6 +309,7 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Exiting with',iszv,' levels'
 
+9998 continue
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/amg_zfile_prec_descr.f90

@@ -58,17 +58,26 @@
 !             The id of the process printing the message; -1 acts as a wildcard.
 !             Default is psb_root_
 !
-subroutine amg_zfile_prec_descr(prec,iout,root)
+!
+!
+! verbosity:
+!        <0: suppress all messages
+!         0: normal
+!        >1: increased details 
+!
+subroutine amg_zfile_prec_descr(prec,iout,root, verbosity)
   use psb_base_mod
   use amg_z_prec_mod, amg_protect_name => amg_zfile_prec_descr
   use amg_z_inner_mod
   use amg_z_gs_solver
-  
+
   implicit none 
   ! Arguments
   class(amg_zprec_type), intent(in)      :: prec
   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
@@ -76,8 +85,7 @@ subroutine amg_zfile_prec_descr(prec,iout,root)
   integer(psb_ipk_)   :: me, np
   logical             :: is_symgs
   character(len=20), parameter :: name='amg_file_prec_descr'
-  integer(psb_ipk_)  :: iout_
-  integer(psb_ipk_)  :: root_
+  integer(psb_ipk_)  :: iout_, root_, verbosity_
 
   info = psb_success_
   if (present(iout)) then 
@@ -86,6 +94,12 @@ subroutine amg_zfile_prec_descr(prec,iout,root)
     iout_ = psb_out_unit
   end if
   if (iout_ < 0) iout_ = psb_out_unit
+  if (present(verbosity)) then
+    verbosity_ = verbosity
+  else
+    verbosity_ = 0
+  end if
+  if (verbosity_ < 0) goto 9998
 
   ctxt = prec%ctxt
 
@@ -99,102 +113,104 @@ subroutine amg_zfile_prec_descr(prec,iout,root)
     end if
     if (root_ == -1) root_ = me
 
-    !
-    ! The preconditioner description is printed by processor psb_root_.
-    ! This agrees with the fact that all the parameters defining the
-    ! preconditioner have the same values on all the procs (this is
-    ! ensured by amg_precbld).
-    !
-    if (me == root_) then
-      nlev = size(prec%precv)
-      do ilev = 1, nlev 
-        if (.not.allocated(prec%precv(ilev)%sm)) then 
-          info = 3111
-          write(iout_,*) ' ',name,&
-               & ': error: inconsistent MLPREC part, should call amg_PRECINIT'
-          return
-        endif
-      end do
+    if (verbosity_ >=0) then 
+      !
+      ! The preconditioner description is printed by processor psb_root_.
+      ! This agrees with the fact that all the parameters defining the
+      ! preconditioner have the same values on all the procs (this is
+      ! ensured by amg_precbld).
+      !
+      if (me == root_) then
+        nlev = size(prec%precv)
+        do ilev = 1, nlev 
+          if (.not.allocated(prec%precv(ilev)%sm)) then 
+            info = 3111
+            write(iout_,*) ' ',name,&
+                 & ': error: inconsistent MLPREC part, should call amg_PRECINIT'
+            return
+          endif
+        end do
 
-      write(iout_,*) 
-      write(iout_,'(a)') 'Preconditioner description'
+        write(iout_,*) 
+        write(iout_,'(a)') 'Preconditioner description'
 
-      if (nlev == 1) then
-        !
-        ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel.
-        ! Will need rethinking...
-        !
-        if (allocated(prec%precv(1)%sm2a)) then
-          is_symgs = .false.
-          select type(sv2 => prec%precv(1)%sm2a%sv)
-          class is (amg_z_bwgs_solver_type)
-            select type(sv1 => prec%precv(1)%sm%sv)
-            class is (amg_z_gs_solver_type)
-              is_symgs = .true.
+        if (nlev == 1) then
+          !
+          ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel.
+          ! Will need rethinking...
+          !
+          if (allocated(prec%precv(1)%sm2a)) then
+            is_symgs = .false.
+            select type(sv2 => prec%precv(1)%sm2a%sv)
+            class is (amg_z_bwgs_solver_type)
+              select type(sv1 => prec%precv(1)%sm%sv)
+              class is (amg_z_gs_solver_type)
+                is_symgs = .true.
+              end select
             end select
-          end select
-          if (is_symgs) then
-            write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel'
+            if (is_symgs) then
+              write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel'
+            else
+              write(iout_,*) 'Pre Smoother: '
+              call prec%precv(1)%sm%descr(info,iout=iout_)
+              write(iout_,*) 'Post smoother:'
+              call prec%precv(1)%sm2a%descr(info,iout=iout_)
+            end if
+            nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post)
+
           else
+            call prec%precv(1)%sm%descr(info,iout=iout_)
+            nswps = prec%precv(1)%parms%sweeps_pre
+          end if
+          if (nswps > 1)  write(iout_,*) '  Number of  sweeps : ',nswps
+          write(iout_,*) 
+
+        else if (nlev > 1) then
+          !
+          ! Print description of base preconditioner
+          !
+          write(iout_,*) 'Multilevel Preconditioner'
+          write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
+          write(iout_,*) 
+          if (allocated(prec%precv(1)%sm2a)) then
             write(iout_,*) 'Pre Smoother: '
             call prec%precv(1)%sm%descr(info,iout=iout_)
             write(iout_,*) 'Post smoother:'
             call prec%precv(1)%sm2a%descr(info,iout=iout_)
+          else
+            write(iout_,*) 'Smoother: '
+            call prec%precv(1)%sm%descr(info,iout=iout_)
           end if
-          nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post)
+          !
+          ! Print multilevel details
+          !
+          write(iout_,*) 
+          write(iout_,*) 'Multilevel hierarchy: '
+          write(iout_,*) ' Number of levels   : ',nlev
+          write(iout_,*) ' Operator complexity: ',prec%get_complexity()
+          write(iout_,*) ' Average coarsening : ',prec%get_avg_cr()
+          ilmin = 2
+          if (nlev == 2) ilmin=1
+          do ilev=ilmin,nlev
+            call prec%precv(ilev)%descr(ilev,nlev,ilmin,info, &
+                 & iout=iout_,verbosity=verbosity)
+          end do
+          write(iout_,*) 
 
         else
-          call prec%precv(1)%sm%descr(info,iout=iout_)
-          nswps = prec%precv(1)%parms%sweeps_pre
+          write(iout_,*) trim(name), &
+               & ': invalid preconditioner array size ?',nlev
+          info = -2
+          return
+
         end if
-        if (nswps > 1)  write(iout_,*) '  Number of  sweeps : ',nswps
-        write(iout_,*) 
-
-      else if (nlev > 1) then
-        !
-        ! Print description of base preconditioner
-        !
-        write(iout_,*) 'Multilevel Preconditioner'
-        write(iout_,*) 'Outer sweeps:',prec%outer_sweeps
-        write(iout_,*) 
-        if (allocated(prec%precv(1)%sm2a)) then
-          write(iout_,*) 'Pre Smoother: '
-          call prec%precv(1)%sm%descr(info,iout=iout_)
-          write(iout_,*) 'Post smoother:'
-          call prec%precv(1)%sm2a%descr(info,iout=iout_)
-        else
-          write(iout_,*) 'Smoother: '
-          call prec%precv(1)%sm%descr(info,iout=iout_)
-        end if
-        !
-        ! Print multilevel details
-        !
-        write(iout_,*) 
-        write(iout_,*) 'Multilevel hierarchy: '
-        write(iout_,*) ' Number of levels   : ',nlev
-        write(iout_,*) ' Operator complexity: ',prec%get_complexity()
-        write(iout_,*) ' Average coarsening : ',prec%get_avg_cr()
-        ilmin = 2
-        if (nlev == 2) ilmin=1
-        do ilev=ilmin,nlev
-          call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
-        end do
-        write(iout_,*) 
-
-      else
-        write(iout_,*) trim(name), &
-             & ': invalid preconditioner array size ?',nlev
-        info = -2
-        return
-
       end if
     end if
-
   else
     write(iout_,*) trim(name), &
          & ': Error: no base preconditioner available, something is wrong!'
     info = -2
     return
   endif
-
+9998 continue
 end subroutine amg_zfile_prec_descr

amgprec/impl/amg_zmlprec_aply.f90

@@ -393,38 +393,39 @@ contains
     if(debug_level > 1) then
       write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
     end if
-
-    select case(p%precv(level)%parms%ml_cycle) 
-
-    case(amg_no_ml_)
-      !
-      ! No preconditioning, should not really get here
-      ! 
-      call psb_errpush(psb_err_internal_error_,name,&
-           & a_err='amg_no_ml_ in mlprc_aply?')
-      goto 9999      
-
-    case(amg_add_ml_)
-
-      call amg_z_inner_add(p, level, trans, work)
-
-    case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
-
-      call amg_z_inner_mult(p, level, trans, work)
-      
-    case(amg_kcycle_ml_, amg_kcyclesym_ml_)
-
-      call amg_z_inner_k_cycle(p, level, trans, work)
-      
-    case default
-      info = psb_err_from_subroutine_ai_
-      call psb_errpush(info,name,a_err='invalid ml_cycle',&
-           &  i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
-      goto 9999      
-
-    end select
-    if(debug_level > 1) then
-      write(debug_unit,*) me,' End inner_ml_aply at level ',level
+    if (me >= 0) then
+      select case(p%precv(level)%parms%ml_cycle) 
+        
+      case(amg_no_ml_)
+        !
+        ! No preconditioning, should not really get here
+        ! 
+        call psb_errpush(psb_err_internal_error_,name,&
+             & a_err='amg_no_ml_ in mlprc_aply?')
+        goto 9999      
+        
+      case(amg_add_ml_)
+        
+        call amg_z_inner_add(p, level, trans, work)
+        
+      case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
+        
+        call amg_z_inner_mult(p, level, trans, work)
+        
+      case(amg_kcycle_ml_, amg_kcyclesym_ml_)
+        
+        call amg_z_inner_k_cycle(p, level, trans, work)
+        
+      case default
+        info = psb_err_from_subroutine_ai_
+        call psb_errpush(info,name,a_err='invalid ml_cycle',&
+             &  i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
+        goto 9999      
+        
+      end select
+      if(debug_level > 1) then
+        write(debug_unit,*) me,' End inner_ml_aply at level ',level
+      end if
     end if
 
     call psb_erractionrestore(err_act)
@@ -492,28 +493,30 @@ contains
          & base_a => p%precv(level)%base_a, base_desc=>p%precv(level)%base_desc,&
          & wv => p%precv(level)%wrk%wv)
 
-      if (allocated(p%precv(level)%sm2a)) then
-        call psb_geaxpby(zone,vx2l,zzero,vy2l,base_desc,info)
-
-        sweeps = max(p%precv(level)%parms%sweeps_pre,p%precv(level)%parms%sweeps_post)
-        do k=1, sweeps
+      if (me >= 0) then 
+        if (allocated(p%precv(level)%sm2a)) then
+          call psb_geaxpby(zone,vx2l,zzero,vy2l,base_desc,info)
+          
+          sweeps = max(p%precv(level)%parms%sweeps_pre,p%precv(level)%parms%sweeps_post)
+          do k=1, sweeps
+            call p%precv(level)%sm%apply(zone,&
+                 & vy2l,zzero,vty,&
+                 & base_desc, trans,&
+                 & ione,work,wv,info,init='Z')
+            
+            call p%precv(level)%sm2a%apply(zone,&
+                 & vty,zzero,vy2l,&
+                 & base_desc, trans,&
+                 & ione,work,wv,info,init='Z')        
+          end do
+          
+        else
+          sweeps = p%precv(level)%parms%sweeps_pre
           call p%precv(level)%sm%apply(zone,&
-               & vy2l,zzero,vty,&
+               & vx2l,zzero,vy2l,&
                & base_desc, trans,&
-               & ione,work,wv,info,init='Z')
-
-          call p%precv(level)%sm2a%apply(zone,&
-               & vty,zzero,vy2l,&
-               & base_desc, trans,&
-               & ione,work,wv,info,init='Z')        
-        end do
-
-      else
-        sweeps = p%precv(level)%parms%sweeps_pre
-        call p%precv(level)%sm%apply(zone,&
-             & vx2l,zzero,vy2l,&
-             & base_desc, trans,&
-             & sweeps,work,wv,info,init='Z')
+               & sweeps,work,wv,info,init='Z')
+        end if
       end if
       if (info /= psb_success_) then
         call psb_errpush(psb_err_internal_error_,name,&
@@ -523,7 +526,7 @@ contains
 
       if (level < nlev) then
         ! Apply the restriction
-        call p%precv(level+1)%map%map_U2V(zone,vx2l,&
+        call p%precv(level+1)%map_rstr(zone,vx2l,&
              & zzero,p%precv(level+1)%wrk%vx2l,&
              & info,work=work,&
              & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -543,7 +546,7 @@ contains
         !
         ! Apply the prolongator
         !  
-        call p%precv(level+1)%map%map_V2U(zone,&
+        call p%precv(level+1)%map_prol(zone,&
              & p%precv(level+1)%wrk%vy2l, zone,vy2l,&
              & info,work=work,&
              & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -602,7 +605,6 @@ contains
     end if
     ctxt = p%precv(level)%base_desc%get_context()
     call psb_info(ctxt, me, np)
-
     if(debug_level > 1) then
       write(debug_unit,*) me,' inner_mult at level ',level
     end if
@@ -623,22 +625,25 @@ contains
         !
 
         if (pre) then
-          if (trans == 'N') then 
-            sweeps = p%precv(level)%parms%sweeps_pre
-            if (info == psb_success_) call p%precv(level)%sm%apply(zone,&
-                 & vx2l,zzero,vy2l,base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
-          else
-            sweeps = p%precv(level)%parms%sweeps_post
-            if (info == psb_success_) call p%precv(level)%sm2%apply(zone,&
-                 & vx2l,zzero,vy2l, base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
-          end if
-
-          if (info /= psb_success_) then
-            call psb_errpush(psb_err_internal_error_,name,&
-                 & a_err='Error during PRE smoother_apply')
-            goto 9999
+          if (me >=0) then
+!!$            write(0,*) me,'Applying smoother pre ', level
+            if (trans == 'N') then 
+              sweeps = p%precv(level)%parms%sweeps_pre
+              if (info == psb_success_) call p%precv(level)%sm%apply(zone,&
+                   & vx2l,zzero,vy2l,base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            else
+              sweeps = p%precv(level)%parms%sweeps_post
+              if (info == psb_success_) call p%precv(level)%sm2%apply(zone,&
+                   & vx2l,zzero,vy2l, base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            end if
+            
+            if (info /= psb_success_) then
+              call psb_errpush(psb_err_internal_error_,name,&
+                   & a_err='Error during PRE smoother_apply')
+              goto 9999
+            end if
           end if
         endif
         !
@@ -657,7 +662,7 @@ contains
                  & a_err='Error during residue')
             goto 9999
           end if
-          call p%precv(level+1)%map%map_U2V(zone,vty,&
+          call p%precv(level+1)%map_rstr(zone,vty,&
                & zzero,p%precv(level+1)%wrk%vx2l,&
                & info,work=work,&
                & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -668,7 +673,7 @@ contains
           end if
         else
           ! Shortcut: just transfer x2l. 
-          call p%precv(level+1)%map%map_U2V(zone,vx2l,&
+          call p%precv(level+1)%map_rstr(zone,vx2l,&
                & zzero,p%precv(level+1)%wrk%vx2l,&
                & info,work=work,&
                & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -684,7 +689,7 @@ contains
         !
         ! Apply the prolongator
         !  
-        call p%precv(level+1)%map%map_V2U(zone,&
+        call p%precv(level+1)%map_prol(zone,&
              & p%precv(level+1)%wrk%vy2l,zone,vy2l,&
              & info,work=work,&
              & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -696,13 +701,15 @@ contains
 
         if (p%precv(level)%parms%ml_cycle == amg_wcycle_ml_) then
 
-          call psb_geaxpby(zone,vx2l, zzero,vty,&
-               & base_desc,info)        
-          if (info == psb_success_) call psb_spmm(-zone,base_a,&
-               & vy2l,zone,vty,&
-               & base_desc,info,work=work,trans=trans)
+          if (me >=0) then 
+            call psb_geaxpby(zone,vx2l, zzero,vty,&
+                 & base_desc,info)        
+            if (info == psb_success_) call psb_spmm(-zone,base_a,&
+                 & vy2l,zone,vty,&
+                 & base_desc,info,work=work,trans=trans)
+          end if
           if (info == psb_success_) &
-               & call p%precv(level+1)%map%map_U2V(zone,vty,&
+               & call p%precv(level+1)%map_rstr(zone,vty,&
                & zzero,p%precv(level+1)%wrk%vx2l,info,work=work,&
                & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
           if (info /= psb_success_) then
@@ -713,7 +720,7 @@ contains
 
           call inner_ml_aply(level+1,p,trans,work,info)
 
-          if (info == psb_success_) call p%precv(level+1)%map%map_V2U(zone, &
+          if (info == psb_success_) call p%precv(level+1)%map_prol(zone, &
                & p%precv(level+1)%wrk%vy2l,zone,vy2l,&
                & info,work=work,&
                & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -728,31 +735,33 @@ contains
 
 
         if (post) then
-          call psb_geaxpby(zone,vx2l,&
-               & zzero,vty,&
-               & base_desc,info)
-          if (info == psb_success_) call psb_spmm(-zone,base_a,&
-               & vy2l, zone,vty,base_desc,info,&
-               & work=work,trans=trans)
-          if (info /= psb_success_) then
-            call psb_errpush(psb_err_internal_error_,name,&
-                 & a_err='Error during residue')
-            goto 9999
-          end if
-
-          !
-          ! Apply the second smoother
-          !
-          if (trans == 'N') then
-            sweeps = p%precv(level)%parms%sweeps_post
-            if (info == psb_success_) call p%precv(level)%sm2%apply(zone,&
-                 & vty,zone,vy2l, base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
-          else 
-            sweeps = p%precv(level)%parms%sweeps_pre
-            if (info == psb_success_) call p%precv(level)%sm%apply(zone,&
-                 & vty,zone,vy2l, base_desc, trans,&
-                 & sweeps,work,wv,info,init='Z')
+          if (me >=0) then 
+            call psb_geaxpby(zone,vx2l,&
+                 & zzero,vty,&
+                 & base_desc,info)
+            if (info == psb_success_) call psb_spmm(-zone,base_a,&
+                 & vy2l, zone,vty,base_desc,info,&
+                 & work=work,trans=trans)
+            if (info /= psb_success_) then
+              call psb_errpush(psb_err_internal_error_,name,&
+                   & a_err='Error during residue')
+              goto 9999
+            end if
+            
+            !
+            ! Apply the second smoother
+            !
+            if (trans == 'N') then
+              sweeps = p%precv(level)%parms%sweeps_post
+              if (info == psb_success_) call p%precv(level)%sm2%apply(zone,&
+                   & vty,zone,vy2l, base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            else 
+              sweeps = p%precv(level)%parms%sweeps_pre
+              if (info == psb_success_) call p%precv(level)%sm%apply(zone,&
+                   & vty,zone,vy2l, base_desc, trans,&
+                   & sweeps,work,wv,info,init='Z')
+            end if
           end if
 
           if (info /= psb_success_) then
@@ -764,11 +773,14 @@ contains
         endif
 
       else if (level == nlev) then
-
-        sweeps = p%precv(level)%parms%sweeps_pre
-        if (info == psb_success_) call p%precv(level)%sm%apply(zone,&
-             & vx2l,zzero,vy2l,base_desc, trans,&
-             & sweeps,work,wv,info)
+!!$        write(0,*) me,'Applying smoother at top level ',psb_errstatus_fatal()
+        if (me >=0) then 
+          sweeps = p%precv(level)%parms%sweeps_pre
+          if (info == psb_success_) call p%precv(level)%sm%apply(zone,&
+               & vx2l,zzero,vy2l,base_desc, trans,&
+               & sweeps,work,wv,info)
+        end if 
+!!$        write(0,*) me,' Done applying smoother at top level ',psb_errstatus_fatal()
 
       else
 
@@ -778,7 +790,7 @@ contains
         goto 9999
       end if
     end associate
-    
+9998 continue
     call psb_erractionrestore(err_act)
     return
 
@@ -829,72 +841,73 @@ contains
     end if
     ctxt = p%precv(level)%base_desc%get_context()
     call psb_info(ctxt, me, np)
-
+    
     if(debug_level > 1) then
       write(debug_unit,*) me,name,' start at level ',level
     end if
-
+    
     if ((level<1).or.(level>nlev)) then
       info = psb_err_internal_error_ 
       call psb_errpush(info,name,&
            & a_err='Invalid LEVEL>NLEV')
       goto 9999
     end if
-
+    
     !K cycle
     
     associate(vx2l => p%precv(level)%wrk%vx2l,vy2l => p%precv(level)%wrk%vy2l,&
          & vtx => p%precv(level)%wrk%vtx,vty => p%precv(level)%wrk%vty,&
          & base_a => p%precv(level)%base_a, base_desc=>p%precv(level)%base_desc,&
          & wv => p%precv(level)%wrk%wv(8:))
+
       if (level == nlev) then 
-        !
-        ! Apply smoother 
-        !
-        sweeps = p%precv(level)%parms%sweeps_pre
-        if (info == psb_success_) call p%precv(level)%sm%apply(zone,&
-             & vx2l,zzero,vy2l,base_desc, trans,&
-             & sweeps,work,wv,info,init='Z')
-
-      else  if (level < nlev) then 
-
-        if (trans == 'N') then 
+        if (me >= 0) then 
+          !
+          ! Apply smoother 
+          !
           sweeps = p%precv(level)%parms%sweeps_pre
           if (info == psb_success_) call p%precv(level)%sm%apply(zone,&
                & vx2l,zzero,vy2l,base_desc, trans,&
                & sweeps,work,wv,info,init='Z')
-        else
-          sweeps = p%precv(level)%parms%sweeps_post
-          if (info == psb_success_) call p%precv(level)%sm2%apply(zone,&
-               & vx2l,zzero,vy2l,base_desc, trans,&
-               & sweeps,work,wv,info,init='Z')
         end if
+      else  if (level < nlev) then 
+        if (me >= 0) then 
 
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during 2-PRE smoother_apply')
-          goto 9999
+          if (trans == 'N') then 
+            sweeps = p%precv(level)%parms%sweeps_pre
+            if (info == psb_success_) call p%precv(level)%sm%apply(zone,&
+                 & vx2l,zzero,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          else
+            sweeps = p%precv(level)%parms%sweeps_post
+            if (info == psb_success_) call p%precv(level)%sm2%apply(zone,&
+                 & vx2l,zzero,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          end if
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during 2-PRE smoother_apply')
+            goto 9999
+          end if
+
+          !
+          ! Compute the residual and call recursively
+          !
+
+          call psb_geaxpby(zone,vx2l,&
+               & zzero,vty,&
+               & base_desc,info)
+
+          if (info == psb_success_) call psb_spmm(-zone,base_a,&
+               & vy2l,zone,vty,base_desc,info,work=work,trans=trans)
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during residue')
+            goto 9999
+          end if
         end if
-
-
-        !
-        ! Compute the residual and call recursively
-        !
-
-        call psb_geaxpby(zone,vx2l,&
-             & zzero,vty,&
-             & base_desc,info)
-
-        if (info == psb_success_) call psb_spmm(-zone,base_a,&
-             & vy2l,zone,vty,base_desc,info,work=work,trans=trans)
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during residue')
-          goto 9999
-        end if
-
         ! Apply the restriction
-        call  p%precv(level + 1)%map%map_U2V(zone,vty,&
+        call  p%precv(level + 1)%map_rstr(zone,vty,&
              & zzero,p%precv(level + 1)%wrk%vx2l,&
              &info,work=work,&
              & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -930,7 +943,7 @@ contains
         !
         ! Apply the prolongator
         !  
-        call p%precv(level+1)%map%map_V2U(zone,&
+        call p%precv(level+1)%map_prol(zone,&
              & p%precv(level+1)%wrk%vy2l,zone,vy2l,&
              & info,work=work,&
              & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -940,40 +953,42 @@ contains
                & a_err='Error during prolongation')
           goto 9999
         end if
+        if (me >= 0) then 
+          !
+          ! Compute the residual
+          !
+          call psb_geaxpby(zone,vx2l,&
+               & zzero,vty,base_desc,info)
+          call psb_spmm(-zone,base_a,vy2l,&
+               & zone,vty,base_desc,info,&
+               & work=work,trans=trans)
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during residue')
+            goto 9999
+          end if
+          !
+          ! Apply the smoother
+          !
+          if (trans == 'N') then 
+            sweeps = p%precv(level)%parms%sweeps_post
+            if (info == psb_success_) call p%precv(level)%sm2%apply(zone,&
+                 & vty,zone,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          else
+            sweeps = p%precv(level)%parms%sweeps_pre
+            if (info == psb_success_) call p%precv(level)%sm%apply(zone,&
+                 & vty,zone,vy2l,base_desc, trans,&
+                 & sweeps,work,wv,info,init='Z')
+          end if
 
-        !
-        ! Compute the residual
-        !
-        call psb_geaxpby(zone,vx2l,&
-             & zzero,vty,base_desc,info)
-        call psb_spmm(-zone,base_a,vy2l,&
-             & zone,vty,base_desc,info,&
-             & work=work,trans=trans)
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during residue')
-          goto 9999
-        end if
-        !
-        ! Apply the smoother
-        !
-        if (trans == 'N') then 
-          sweeps = p%precv(level)%parms%sweeps_post
-          if (info == psb_success_) call p%precv(level)%sm2%apply(zone,&
-               & vty,zone,vy2l,base_desc, trans,&
-               & sweeps,work,wv,info,init='Z')
-        else
-          sweeps = p%precv(level)%parms%sweeps_pre
-          if (info == psb_success_) call p%precv(level)%sm%apply(zone,&
-               & vty,zone,vy2l,base_desc, trans,&
-               & sweeps,work,wv,info,init='Z')
+          if (info /= psb_success_) then
+            call psb_errpush(psb_err_internal_error_,name,&
+                 & a_err='Error during POST smoother_apply')
+            goto 9999
+          end if
         end if
 
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_internal_error_,name,&
-               & a_err='Error during POST smoother_apply')
-          goto 9999
-        end if
       else
 
         info = psb_err_internal_error_ 
@@ -990,8 +1005,7 @@ contains
     return
 
   end subroutine amg_z_inner_k_cycle
-
-
+  
   recursive subroutine amg_zinneritkcycle(p, level, trans, work, innersolv)
     use psb_base_mod
     use amg_prec_mod
@@ -1423,7 +1437,7 @@ contains
 
     if (level < nlev) then
       ! Apply the restriction
-      call p%precv(level+1)%map%map_U2V(zone,mlwrk(level)%x2l,&
+      call p%precv(level+1)%map_rstr(zone,mlwrk(level)%x2l,&
            & zzero,mlwrk(level+1)%x2l,&
            & info,work=work)
       mlwrk(level+1)%y2l(:) = zzero
@@ -1443,7 +1457,7 @@ contains
       !
       ! Apply the prolongator and add correction.
       !  
-      call p%precv(level+1)%map%map_V2U(zone,&
+      call p%precv(level+1)%map_prol(zone,&
            & mlwrk(level+1)%y2l,zone,mlwrk(level)%y2l,&
            & info,work=work)
       if (info /= psb_success_) then
@@ -1564,7 +1578,7 @@ contains
                & a_err='Error during residue')
           goto 9999
         end if
-        call p%precv(level+1)%map%map_U2V(zone,mlwrk(level)%ty,&
+        call p%precv(level+1)%map_rstr(zone,mlwrk(level)%ty,&
              & zzero,mlwrk(level+1)%x2l,info,work=work)
         if (info /= psb_success_) then
           call psb_errpush(psb_err_internal_error_,name,&
@@ -1573,7 +1587,7 @@ contains
         end if
       else
         ! Shortcut: just transfer x2l. 
-        call p%precv(level+1)%map%map_U2V(zone,mlwrk(level)%x2l,&
+        call p%precv(level+1)%map_rstr(zone,mlwrk(level)%x2l,&
              & zzero,mlwrk(level+1)%x2l,info,work=work)
         if (info /= psb_success_) then
           call psb_errpush(psb_err_internal_error_,name,&
@@ -1602,7 +1616,7 @@ contains
       !
       ! Apply the prolongator
       !  
-      call p%precv(level+1)%map%map_V2U(zone,mlwrk(level+1)%y2l,&
+      call p%precv(level+1)%map_prol(zone,mlwrk(level+1)%y2l,&
            & zone,mlwrk(level)%y2l,info,work=work)
       if (info /= psb_success_) then
         call psb_errpush(psb_err_internal_error_,name,&

amgprec/impl/amg_zprecinit.F90

@@ -127,7 +127,8 @@ subroutine amg_zprecinit(ctxt,prec,ptype,info)
     endif
   endif
   prec%ctxt = ctxt
-  prec%ag_data%min_coarse_size = -1
+  prec%ag_data%min_coarse_size             = -1
+  prec%ag_data%min_coarse_size_per_process = -1
 
   select case(psb_toupper(trim(ptype)))
   case ('NOPREC','NONE') 

amgprec/impl/level/Makefile

@@ -21,6 +21,8 @@ amg_c_base_onelev_mat_asb.o \
 amg_c_base_onelev_setag.o \
 amg_c_base_onelev_setsm.o \
 amg_c_base_onelev_setsv.o \
+amg_c_base_onelev_map_rstr.o \
+amg_c_base_onelev_map_prol.o \
 amg_d_base_onelev_build.o \
 amg_d_base_onelev_check.o \
 amg_d_base_onelev_cnv.o \
@@ -34,6 +36,8 @@ amg_d_base_onelev_mat_asb.o \
 amg_d_base_onelev_setag.o \
 amg_d_base_onelev_setsm.o \
 amg_d_base_onelev_setsv.o \
+amg_d_base_onelev_map_rstr.o \
+amg_d_base_onelev_map_prol.o \
 amg_s_base_onelev_build.o \
 amg_s_base_onelev_check.o \
 amg_s_base_onelev_cnv.o \
@@ -47,6 +51,8 @@ amg_s_base_onelev_mat_asb.o \
 amg_s_base_onelev_setag.o \
 amg_s_base_onelev_setsm.o \
 amg_s_base_onelev_setsv.o \
+amg_s_base_onelev_map_rstr.o \
+amg_s_base_onelev_map_prol.o \
 amg_z_base_onelev_build.o \
 amg_z_base_onelev_check.o \
 amg_z_base_onelev_cnv.o \
@@ -59,7 +65,9 @@ amg_z_base_onelev_free.o \
 amg_z_base_onelev_mat_asb.o \
 amg_z_base_onelev_setag.o \
 amg_z_base_onelev_setsm.o \
-amg_z_base_onelev_setsv.o 
+amg_z_base_onelev_setsv.o \
+amg_z_base_onelev_map_rstr.o \
+amg_z_base_onelev_map_prol.o 
 
 
 LIBNAME=libamg_prec.a

amgprec/impl/level/amg_c_base_onelev_build.f90

@@ -71,72 +71,81 @@ subroutine amg_c_base_onelev_build(lv,info,amold,vmold,imold,ilv)
   ctxt = lv%base_desc%get_ctxt()
   call psb_info(ctxt,me,np)
 
-  if (.not.allocated(lv%sm)) then 
-    !! Error: should have called amg_dprecinit
-    info=3111
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-  if (.not.allocated(lv%sm%sv)) then 
-    !! Error: should have called amg_dprecinit
-    info=3111
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-  lv%ac_nz_loc = lv%ac%get_nzeros()
-  lv%ac_nz_tot = lv%ac_nz_loc
-  select case(lv%parms%coarse_mat)
-  case(amg_distr_mat_) 
-    call psb_sum(ctxt,lv%ac_nz_tot)
-  case(amg_repl_mat_)
-    ! Do nothing
-  case default
-    ! Should never get here
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='Wrong lv%parms')
-    goto 9999
-  end select
-  
-  
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Calling mlprcbld at level  ',i
-  call amg_check_def(lv%parms%sweeps_pre,&
-       & 'Jacobi sweeps',izero,is_int_non_negative)
-  call amg_check_def(lv%parms%sweeps_post,&
-       & 'Jacobi sweeps',izero,is_int_non_negative)
-
-  call lv%sm%build(lv%base_a,lv%base_desc,info)
-  if (info == 0) then
-    if (allocated(lv%sm2a)) then 
-      call lv%sm2a%build(lv%base_a,lv%base_desc,info)
-      lv%sm2 => lv%sm2a
-    else
-      lv%sm2 => lv%sm
+  !
+  ! At top level(s) I may be using
+  ! a context with less processes
+  !
+  if (me < 0) then
+!!$    write(0,*) 'onelevbld: I am excluded from this one '
+  else
+!!$    write(0,*) me,' Going to build smoothers at this level '
+    if (.not.allocated(lv%sm)) then 
+      !! Error: should have called amg_dprecinit
+      info=3111
+      call psb_errpush(info,name)
+      goto 9999
     end if
-  end if
-  if (info /=0 ) then
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,&
-         & a_err='Smoother bld error')
-    goto 9999
-  end if
-
-  if (lv%sm%sv%is_global()) then
-    if ((lv%parms%sweeps_pre>1).or.(lv%parms%sweeps_post>1)) then
-      lv%parms%sweeps_pre  = 1
-      lv%parms%sweeps_post = 1
-      if (me == 0) then
-        write(debug_unit,*) 
-        if (present(ilv)) then
-          write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
-               & '" at level ',ilv
-          write(debug_unit,*) '         is configured as a global solver '
-        else
-          write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
-               & '" is configured as a global solver '
+    if (.not.allocated(lv%sm%sv)) then 
+      !! Error: should have called amg_dprecinit
+      info=3111
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+    lv%ac_nz_loc = lv%ac%get_nzeros()
+    lv%ac_nz_tot = lv%ac_nz_loc
+    select case(lv%parms%coarse_mat)
+    case(amg_distr_mat_) 
+      call psb_sum(ctxt,lv%ac_nz_tot)
+    case(amg_repl_mat_)
+      ! Do nothing
+    case default
+      ! Should never get here
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,a_err='Wrong lv%parms')
+      goto 9999
+    end select
+    
+    
+    if (debug_level >= psb_debug_outer_) &
+         & write(debug_unit,*) me,' ',trim(name),&
+         & 'Calling mlprcbld at level  ',i
+    call amg_check_def(lv%parms%sweeps_pre,&
+         & 'Jacobi sweeps',izero,is_int_non_negative)
+    call amg_check_def(lv%parms%sweeps_post,&
+         & 'Jacobi sweeps',izero,is_int_non_negative)
+    
+    call lv%sm%build(lv%base_a,lv%base_desc,info)
+    if (info == 0) then
+      if (allocated(lv%sm2a)) then 
+        call lv%sm2a%build(lv%base_a,lv%base_desc,info)
+        lv%sm2 => lv%sm2a
+      else
+        lv%sm2 => lv%sm
+      end if
+    end if
+    if (info /=0 ) then
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,&
+           & a_err='Smoother bld error')
+      goto 9999
+    end if
+    
+    if (lv%sm%sv%is_global()) then
+      if ((lv%parms%sweeps_pre>1).or.(lv%parms%sweeps_post>1)) then
+        lv%parms%sweeps_pre  = 1
+        lv%parms%sweeps_post = 1
+        if (me == 0) then
+          write(debug_unit,*) 
+          if (present(ilv)) then
+            write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
+                 & '" at level ',ilv
+            write(debug_unit,*) '         is configured as a global solver '
+          else
+            write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
+                 & '" is configured as a global solver '
+          end if
+          write(debug_unit,*) '        Pre and post sweeps at this level reset to 1'
         end if
-        write(debug_unit,*) '        Pre and post sweeps at this level reset to 1'
       end if
     end if
   end if

amgprec/impl/level/amg_c_base_onelev_cnv.f90

@@ -62,6 +62,6 @@ subroutine amg_c_base_onelev_cnv(lv,info,amold,vmold,imold)
          & call lv%ac%cscnv(info,mold=amold)
     if (info == psb_success_ .and. lv%desc_ac%is_ok() &
          & .and. present(imold)) call lv%desc_ac%cnv(imold)
-    if (info == psb_success_) call lv%map%cnv(info,mold=amold,imold=imold)
+    if (info == psb_success_) call lv%linmap%cnv(info,mold=amold,imold=imold)
   end if
 end subroutine amg_c_base_onelev_cnv

amgprec/impl/level/amg_c_base_onelev_csetc.F90

@@ -1,15 +1,15 @@
-!  
-!   
+!
+!
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
 !               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!    
-!    (C) Copyright 2020 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
+!
+!    (C) Copyright 2020
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
 !    are met:
@@ -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,10 +33,10 @@
 !    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.
-!   
-!  
+!
+!
 subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
-  
+
   use psb_base_mod
   use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_csetc
   use amg_c_base_aggregator_mod
@@ -49,6 +49,9 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
   use amg_c_ilu_solver
   use amg_c_id_solver
   use amg_c_gs_solver
+  use amg_c_ainv_solver
+  use amg_c_invk_solver
+  use amg_c_invt_solver
 #if defined(HAVE_SLU_)
   use amg_c_slu_solver
 #endif
@@ -59,16 +62,16 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
   Implicit None
 
   ! Arguments
-  class(amg_c_onelev_type), intent(inout) :: lv 
-  character(len=*), intent(in)              :: what 
+  class(amg_c_onelev_type), intent(inout) :: lv
+  character(len=*), intent(in)              :: what
   character(len=*), intent(in)              :: val
   integer(psb_ipk_), intent(out)            :: info
   character(len=*), optional, intent(in)    :: pos
   integer(psb_ipk_), intent(in), optional   :: idx
-  ! Local 
+  ! Local
   integer(psb_ipk_)  :: ipos_, err_act
   character(len=20) :: name='c_base_onelev_csetc'
-  integer(psb_ipk_) :: ival 
+  integer(psb_ipk_) :: ival
   type(amg_c_base_smoother_type)   :: amg_c_base_smoother_mold
   type(amg_c_jac_smoother_type)    ::  amg_c_jac_smoother_mold
   type(amg_c_l1_jac_smoother_type) ::  amg_c_l1_jac_smoother_mold
@@ -79,13 +82,16 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
   type(amg_c_id_solver_type)       ::  amg_c_id_solver_mold
   type(amg_c_gs_solver_type)       ::  amg_c_gs_solver_mold
   type(amg_c_bwgs_solver_type)     ::  amg_c_bwgs_solver_mold
+  type(amg_c_ainv_solver_type)     ::  amg_c_ainv_solver_mold
+  type(amg_c_invk_solver_type)     ::  amg_c_invk_solver_mold
+  type(amg_c_invt_solver_type)     ::  amg_c_invt_solver_mold
 #if defined(HAVE_SLU_)
   type(amg_c_slu_solver_type)   ::  amg_c_slu_solver_mold
 #endif
 #if defined(HAVE_MUMPS_)
   type(amg_c_mumps_solver_type) ::  amg_c_mumps_solver_mold
 #endif
-  
+
 
   call psb_erractionsave(err_act)
 
@@ -106,14 +112,14 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
   else
     ipos_ = amg_smooth_both_
   end if
-  
+
   select case (psb_toupper(trim(what)))
   case ('SMOOTHER_TYPE')
     select case (psb_toupper(trim(val)))
     case ('NOPREC','NONE')
       call lv%set(amg_c_base_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_c_id_solver_mold,info,pos=pos)
-      
+
     case ('JAC','JACOBI')
       call lv%set(amg_c_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_c_diag_solver_mold,info,pos=pos)
@@ -121,11 +127,11 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
     case ('L1-JACOBI')
       call lv%set(amg_c_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_c_l1_diag_solver_mold,info,pos=pos)
-      
+
     case ('BJAC')
       call lv%set(amg_c_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_c_ilu_solver_mold,info,pos=pos)
-      
+
     case ('L1-BJAC')
       call lv%set(amg_c_l1_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_c_ilu_solver_mold,info,pos=pos)
@@ -154,67 +160,73 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
     case ('L1-BWGS')
       call lv%set(amg_c_l1_jac_smoother_mold,info,pos='pre')
       if (info == 0) call lv%set(amg_c_bwgs_solver_mold,info,pos='pre')
-      if (allocated(lv%sm2a)) deallocate(lv%sm2a)      
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
     case ('L1-FBGS')
       call lv%set(amg_c_l1_jac_smoother_mold,info,pos='pre')
       if (info == 0) call lv%set(amg_c_gs_solver_mold,info,pos='pre')
       call lv%set(amg_c_l1_jac_smoother_mold,info,pos='post')
       if (info == 0) call lv%set(amg_c_bwgs_solver_mold,info,pos='post')
-      
+
     case default
       !
-      ! Do nothing and hope for the best :) 
+      ! Do nothing and hope for the best :)
       !
     end select
-    if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then 
+    if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
       if (allocated(lv%sm)) call lv%sm%default()
     end if
     if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then
       if (allocated(lv%sm2a)) call lv%sm2a%default()
     end if
-    
+
 
   case('SUB_SOLVE')
     select case (psb_toupper(trim(val)))
     case ('NONE','NOPREC','FACT_NONE')
       call lv%set(amg_c_id_solver_mold,info,pos=pos)
-      
+
     case ('DIAG')
       call lv%set(amg_c_diag_solver_mold,info,pos=pos)
-      
+
     case ('L1-DIAG')
       call lv%set(amg_c_l1_diag_solver_mold,info,pos=pos)
-      
+
     case ('GS','FGS','FWGS')
       call lv%set(amg_c_gs_solver_mold,info,pos=pos)
-      
+
     case ('BGS','BWGS')
       call lv%set(amg_c_bwgs_solver_mold,info,pos=pos)
-      
+
+    case ('AINV')
+      call lv%set(amg_c_ainv_solver_mold,info,pos=pos)
+    case ('INVK')
+      call lv%set(amg_c_invk_solver_mold,info,pos=pos)
+    case ('INVT')
+      call lv%set(amg_c_invt_solver_mold,info,pos=pos)
     case ('ILU','ILUT','MILU')
       call lv%set(amg_c_ilu_solver_mold,info,pos=pos)
       if (info == 0) then
-        if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then 
+        if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
           call lv%sm%sv%set('SUB_SOLVE',val,info)
         end if
-        if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then 
+        if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
           if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
         end if
       end if
 #ifdef HAVE_SLU_
-    case ('SLU') 
+    case ('SLU')
       call lv%set(amg_c_slu_solver_mold,info,pos=pos)
 #endif
 #ifdef HAVE_MUMPS_
-    case ('MUMPS') 
+    case ('MUMPS')
       call lv%set(amg_c_mumps_solver_mold,info,pos=pos)
 #endif
     case default
       !
-      ! Do nothing and hope for the best :) 
+      ! Do nothing and hope for the best :)
       !
     end select
-    
+
   case ('ML_CYCLE')
     lv%parms%ml_cycle      = amg_stringval(val)
 
@@ -229,7 +241,7 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
         return
       end if
     end if
-    
+
     select case(ival)
     case(amg_dec_aggr_)
       allocate(amg_c_dec_aggregator_type :: lv%aggr, stat=info)
@@ -239,7 +251,7 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
       info =  psb_err_internal_error_
     end select
     if (info == psb_success_) call lv%aggr%default()
-    
+
   case ('AGGR_ORD')
     lv%parms%aggr_ord      = amg_stringval(val)
 
@@ -266,13 +278,13 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
     lv%parms%coarse_solve    = amg_stringval(val)
 
   case default
-    if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then 
-      if (allocated(lv%sm)) then 
+    if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
+      if (allocated(lv%sm)) then
         call lv%sm%set(what,val,info,idx=idx)
       end if
     end if
-    if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then 
-      if (allocated(lv%sm2a)) then 
+    if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
+      if (allocated(lv%sm2a)) then
         call lv%sm2a%set(what,val,info,idx=idx)
       end if
     end if

amgprec/impl/level/amg_c_base_onelev_descr.f90

@@ -35,21 +35,30 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout)
+!
+!
+! verbosity:
+!        <0: suppress all messages
+!         0: normal
+!        >1: increased details 
+!
+subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity)
   
   use psb_base_mod
   use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_descr
   Implicit None
   ! Arguments
-  class(amg_c_onelev_type), intent(in)  :: lv
+  class(amg_c_onelev_type), intent(in)    :: lv
   integer(psb_ipk_), intent(in)           :: il,nl,ilmin
   integer(psb_ipk_), intent(out)          :: info
   integer(psb_ipk_), intent(in), optional :: iout
+  integer(psb_ipk_), intent(in), optional :: verbosity
+
 
   ! Local variables
-  integer(psb_ipk_)      :: err_act
+  integer(psb_ipk_)  :: err_act
   character(len=20), parameter :: name='amg_c_base_onelev_descr'
-  integer(psb_ipk_)      :: iout_
+  integer(psb_ipk_)  :: iout_, verbosity_
   logical      :: coarse
 
 
@@ -63,6 +72,13 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout)
   else 
     iout_ = psb_out_unit
   end if
+  
+  if (present(verbosity)) then
+    verbosity_ = verbosity
+  else
+    verbosity_ = 0
+  end if
+  if (verbosity_ < 0) goto 9998
 
   write(iout_,*) 
   if (il == ilmin) then 
@@ -89,12 +105,22 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout)
     call lv%parms%descr(iout_,info,coarse=coarse)
 
     if (nl > 1) then 
-      if (allocated(lv%map%naggr)) then
+      if (allocated(lv%linmap%naggr)) then
         write(iout_,*) '  Coarse Matrix: Global size: ', &
-             &  sum((1_psb_lpk_*lv%map%naggr(:))),' Nonzeros: ',lv%ac_nz_tot
-        write(iout_,*) '          Local matrix sizes: ', &
-             &  lv%map%naggr(:)
-        write(iout_,*) '  Aggregation   ratio: ', &
+             &  lv%linmap%nagtot
+        write(iout_,*) '                    Nonzeros: ',lv%ac_nz_tot
+        if (verbosity_>0) then
+          write(iout_,*) '          Local matrix sizes: ', &
+               &  lv%linmap%naggr(:)
+        else 
+          write(iout_,'(2(a,1x,i12))') &
+               & '     Local  matrix sizes: min:', &
+               & lv%linmap%nagmin,'         max:', lv%linmap%nagmax
+          write(iout_,'(a,1x,f14.1)') &
+               & '                          avg:', &
+               & lv%linmap%nagavg
+        end if
+        write(iout_,'(a,1x,f14.2)') '          Aggregation   ratio: ', &
              &  lv%szratio
       end if
     end if
@@ -102,7 +128,8 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout)
     if (coarse.and.allocated(lv%sm)) &
          & call lv%sm%descr(info,iout=iout_,coarse=coarse)
   end if
-  
+
+9998 continue
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/level/amg_c_base_onelev_dump.f90

@@ -108,17 +108,17 @@ subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
         call lv%ac%print(fname,head=head,iv=ivr)
       end if
       if (rp_) then 
-        ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
-        ivc = lv%map%p_desc_V%get_global_indices(owned=.false.)
+        ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
+        ivc = lv%linmap%p_desc_V%get_global_indices(owned=.false.)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
-        call lv%map%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
+        call lv%linmap%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
-        call lv%map%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
+        call lv%linmap%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
       end if
       if (tprol_) then
         ! Tentative prolongator is stored with column indices already
         ! in global numbering, so only IVR is needed. 
-        ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
+        ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'
         !
         !  This is not implemented yet.
@@ -133,9 +133,9 @@ subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
       end if
       if (rp_) then 
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
-        call lv%map%mat_U2V%print(fname,head=head)
+        call lv%linmap%mat_U2V%print(fname,head=head)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
-        call lv%map%mat_V2U%print(fname,head=head)
+        call lv%linmap%mat_V2U%print(fname,head=head)
       end if
       if (tprol_) then 
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'

amgprec/impl/level/amg_c_base_onelev_free.f90

@@ -63,7 +63,7 @@ subroutine amg_c_base_onelev_free(lv,info)
   call lv%ac%free()
   if (lv%desc_ac%is_ok()) &
        & call lv%desc_ac%free(info)
-  call lv%map%free(info)
+  call lv%linmap%free(info)
 
   ! This is a pointer to something else, must not free it here. 
   nullify(lv%base_a) 

amgprec/impl/level/amg_c_base_onelev_map_prol.F90

@@ -0,0 +1,135 @@
+!  
+!   
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2020 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
+  use psb_base_mod
+  use amg_c_onelev_mod, amg_protect_name =>  amg_c_base_onelev_map_prol_v
+  
+  implicit none
+  class(amg_c_onelev_type), target, intent(inout) :: lv
+  complex(psb_spk_), intent(in)           :: alpha, beta
+  type(psb_c_vect_type), intent(inout) :: vect_u, vect_v
+  integer(psb_ipk_), intent(out)       :: info
+  complex(psb_spk_), optional          :: work(:)
+  type(psb_c_vect_type), optional, target, intent(inout)  :: vtx,vty
+  
+!!$  write(0,*) 'New map_prol',lv%remap_data%ac_pre_remap%is_asb()
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+!!$    write(0,*) 'Remap handling '
+    block
+      type(psb_ctxt_type) :: ctxt, nctxt
+      integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
+      integer(psb_ipk_) :: me, np,  rme, rnp
+      complex(psb_spk_), allocatable :: rsnd(:), rrcv(:)
+      type(psb_c_vect_type) :: tv
+
+      ctxt = lv%remap_data%desc_ac_pre_remap%get_ctxt()
+      call psb_info(ctxt,me,np)
+!!$      write(0,*) 'Old context ',me,np,psb_errstatus_fatal()
+      nctxt = lv%desc_ac%get_ctxt()
+      call psb_info(nctxt,rme,rnp)
+!!$      write(0,*) 'New context ',rme,rnp,psb_errstatus_fatal()
+      idest = lv%remap_data%idest
+      associate(isrc => lv%remap_data%isrc, nrsrc => lv%remap_data%nrsrc)
+!!$        write(0,*) 'Should apply maps, then receive data from ',idest,' to ',me,psb_errstatus_fatal()
+        nsrc = size(isrc)
+        nrl  = lv%remap_data%desc_ac_pre_remap%get_local_rows()
+        nrc  = lv%remap_data%desc_ac_pre_remap%get_local_cols()
+        if (rme >=0) then
+          allocate(rrcv(sum(nrsrc)))
+          rrcv   = vect_v%get_vect()
+!!$          write(0,*) me,rme,' Size check ',size(rrcv),lv%desc_ac%get_local_rows(),psb_errstatus_fatal()
+          kp = 0
+          do i = 1,size(isrc)
+            ip = isrc(i)
+            nrl = nrsrc(i)
+!!$            write(0,*) me,' Sending to ',ip,nrl,kp+1,kp+nrl
+            call psb_snd(ctxt,rrcv(kp+1:kp+nrl),ip)
+            kp = kp + nrl
+          end do
+        end if
+        nrl = lv%remap_data%desc_ac_pre_remap%get_local_rows()
+        call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info)
+!!$        write(0,*) me, ' Allocated ',nrl,info,psb_errstatus_fatal()
+        
+        call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) 
+!!$        write(0,*) me,' Size of TV ',nrl,tv%get_nrows(),info
+!!$        write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal()
+        call psb_realloc(nrc,rsnd,info)
+        call psb_rcv(ctxt,rsnd(1:nrl),idest)
+        call tv%set_vect(rsnd)
+        call lv%linmap%map_V2U(alpha,tv,beta,vect_u,info,&
+             & work=work,vtx=vtx,vty=vty)
+      end associate
+!!$      write(0,*) me, ' Prolongator with remap done '
+!!$      flush(0)
+!!$      call psb_barrier(ctxt)
+    end block
+  else
+    ! Default transfer
+    call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,&
+         & work=work,vtx=vtx,vty=vty)
+  end if
+  
+end subroutine amg_c_base_onelev_map_prol_v
+
+subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
+  use psb_base_mod
+  use amg_c_onelev_mod, amg_protect_name =>  amg_c_base_onelev_map_prol_a
+  implicit none
+  class(amg_c_onelev_type), target, intent(inout) :: lv
+  complex(psb_spk_), intent(in)     :: alpha, beta
+  complex(psb_spk_), intent(inout)   :: u(:)
+  complex(psb_spk_), intent(out)     :: v(:)
+  integer(psb_ipk_), intent(out) :: info
+  complex(psb_spk_), optional          :: work(:)
+
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+    write(0,*) 'Remap handling not implemented yet '
+  else
+    ! Default transfer
+    call lv%linmap%map_V2U(alpha,v,beta,u,info,&
+         & work=work)
+  end if
+  
+end subroutine amg_c_base_onelev_map_prol_a

amgprec/impl/level/amg_c_base_onelev_map_rstr.F90

@@ -0,0 +1,129 @@
+!  
+!   
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2020 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+
+subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
+     &  work,vtx,vty)
+  use psb_base_mod
+  use amg_c_onelev_mod, amg_protect_name =>  amg_c_base_onelev_map_rstr_v
+  implicit none
+  class(amg_c_onelev_type), target, intent(inout) :: lv
+  complex(psb_spk_), intent(in)           :: alpha, beta
+  type(psb_c_vect_type), intent(inout) :: vect_u, vect_v
+  integer(psb_ipk_), intent(out)       :: info
+  complex(psb_spk_), optional          :: work(:)
+  type(psb_c_vect_type), optional, target, intent(inout)  :: vtx,vty
+
+!!$  write(0,*) 'New map_rstr',lv%remap_data%ac_pre_remap%is_asb()
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+!!$    write(0,*) 'Remap handling not implemented yet '
+    block
+      type(psb_ctxt_type) :: ctxt, nctxt
+      integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp
+      integer(psb_ipk_) :: me, np,  rme, rnp
+      complex(psb_spk_), allocatable :: rsnd(:), rrcv(:)
+      type(psb_c_vect_type) :: tv
+      
+      ctxt = lv%remap_data%desc_ac_pre_remap%get_ctxt()
+      call psb_info(ctxt,me,np)
+      nctxt = lv%desc_ac%get_ctxt()
+      call psb_info(nctxt,rme,rnp)
+!!$      write(0,*) 'New context ',rme,rnp
+      idest = lv%remap_data%idest
+      associate(isrc => lv%remap_data%isrc, nrsrc => lv%remap_data%nrsrc)
+!!$        write(0,*) 'Should apply maps, then send data from ',me,' to ',idest
+!!$        if (rme >= 0) write(0,*) rme, '  Receiving      data from ',isrc(:)
+        nsrc = size(isrc)
+        nrl  = lv%remap_data%desc_ac_pre_remap%get_local_rows()
+        call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info)
+        call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) 
+!!$        write(0,*) me,' Size of TV ',tv%get_nrows()
+        call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,&
+             & work=work,vtx=vtx,vty=vty)
+        rsnd = tv%get_vect()
+        call psb_snd(ctxt,rsnd(1:nrl),idest)
+        if (rme >=0) then
+          allocate(rrcv(sum(nrsrc)))
+!!$          write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows()
+          kp = 0
+          do i = 1,size(isrc)
+            ip = isrc(i)
+            nrl = nrsrc(i)
+!!$            write(0,*) me,' Receiving from ',ip,nrl,kp+1,kp+nrl,size(rrcv)
+            call psb_rcv(ctxt,rrcv(kp+1:kp+nrl),ip)
+            kp = kp + nrl
+          end do
+          call vect_v%set_vect(rrcv)
+        end if
+      end associate
+!!$      write(0,*) me, ' Restrictor with remap done '
+    end block
+ 
+  else
+    ! Default transfer
+    call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,&
+         & work=work,vtx=vtx,vty=vty)
+  end if
+  
+end subroutine amg_c_base_onelev_map_rstr_v
+
+subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
+  use psb_base_mod
+  use amg_c_onelev_mod, amg_protect_name =>  amg_c_base_onelev_map_rstr_a
+  implicit none
+  class(amg_c_onelev_type), target, intent(inout) :: lv
+  complex(psb_spk_), intent(in)     :: alpha, beta
+  complex(psb_spk_), intent(inout)   :: u(:)
+  complex(psb_spk_), intent(out)     :: v(:)
+  integer(psb_ipk_), intent(out) :: info
+  complex(psb_spk_), optional       :: work(:)
+
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+    write(0,*) 'Remap handling not implemented yet '
+  else
+    ! Default transfer
+    call lv%linmap%map_U2V(alpha,u,beta,v,info,&
+         & work=work)
+  end if
+  
+end subroutine amg_c_base_onelev_map_rstr_a

amgprec/impl/level/amg_c_base_onelev_mat_asb.f90

@@ -53,7 +53,7 @@
 !  2. Call amg_Xaggrmat_asb to compute prolongator/restrictor/AC
 !  3. According to the choice of DIST/REPL for AC, build a descriptor DESC_AC,
 !     and adjust the column numbering of AC/OP_PROL/OP_RESTR
-!  4. Pack restrictor and prolongator into p%map
+!  4. Pack restrictor and prolongator into p%linmap
 !  5. Fix base_a and base_desc pointers.
 !
 ! 
@@ -158,7 +158,7 @@ subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
   
   if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,&
-       & ilaggr,nlaggr,op_restr,op_prol,lv%map,info)
+       & ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info)
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld')
     goto 9999

amgprec/impl/level/amg_d_base_onelev_build.f90

@@ -71,72 +71,81 @@ subroutine amg_d_base_onelev_build(lv,info,amold,vmold,imold,ilv)
   ctxt = lv%base_desc%get_ctxt()
   call psb_info(ctxt,me,np)
 
-  if (.not.allocated(lv%sm)) then 
-    !! Error: should have called amg_dprecinit
-    info=3111
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-  if (.not.allocated(lv%sm%sv)) then 
-    !! Error: should have called amg_dprecinit
-    info=3111
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-  lv%ac_nz_loc = lv%ac%get_nzeros()
-  lv%ac_nz_tot = lv%ac_nz_loc
-  select case(lv%parms%coarse_mat)
-  case(amg_distr_mat_) 
-    call psb_sum(ctxt,lv%ac_nz_tot)
-  case(amg_repl_mat_)
-    ! Do nothing
-  case default
-    ! Should never get here
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='Wrong lv%parms')
-    goto 9999
-  end select
-  
-  
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Calling mlprcbld at level  ',i
-  call amg_check_def(lv%parms%sweeps_pre,&
-       & 'Jacobi sweeps',izero,is_int_non_negative)
-  call amg_check_def(lv%parms%sweeps_post,&
-       & 'Jacobi sweeps',izero,is_int_non_negative)
-
-  call lv%sm%build(lv%base_a,lv%base_desc,info)
-  if (info == 0) then
-    if (allocated(lv%sm2a)) then 
-      call lv%sm2a%build(lv%base_a,lv%base_desc,info)
-      lv%sm2 => lv%sm2a
-    else
-      lv%sm2 => lv%sm
+  !
+  ! At top level(s) I may be using
+  ! a context with less processes
+  !
+  if (me < 0) then
+!!$    write(0,*) 'onelevbld: I am excluded from this one '
+  else
+!!$    write(0,*) me,' Going to build smoothers at this level '
+    if (.not.allocated(lv%sm)) then 
+      !! Error: should have called amg_dprecinit
+      info=3111
+      call psb_errpush(info,name)
+      goto 9999
     end if
-  end if
-  if (info /=0 ) then
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,&
-         & a_err='Smoother bld error')
-    goto 9999
-  end if
-
-  if (lv%sm%sv%is_global()) then
-    if ((lv%parms%sweeps_pre>1).or.(lv%parms%sweeps_post>1)) then
-      lv%parms%sweeps_pre  = 1
-      lv%parms%sweeps_post = 1
-      if (me == 0) then
-        write(debug_unit,*) 
-        if (present(ilv)) then
-          write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
-               & '" at level ',ilv
-          write(debug_unit,*) '         is configured as a global solver '
-        else
-          write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
-               & '" is configured as a global solver '
+    if (.not.allocated(lv%sm%sv)) then 
+      !! Error: should have called amg_dprecinit
+      info=3111
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+    lv%ac_nz_loc = lv%ac%get_nzeros()
+    lv%ac_nz_tot = lv%ac_nz_loc
+    select case(lv%parms%coarse_mat)
+    case(amg_distr_mat_) 
+      call psb_sum(ctxt,lv%ac_nz_tot)
+    case(amg_repl_mat_)
+      ! Do nothing
+    case default
+      ! Should never get here
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,a_err='Wrong lv%parms')
+      goto 9999
+    end select
+    
+    
+    if (debug_level >= psb_debug_outer_) &
+         & write(debug_unit,*) me,' ',trim(name),&
+         & 'Calling mlprcbld at level  ',i
+    call amg_check_def(lv%parms%sweeps_pre,&
+         & 'Jacobi sweeps',izero,is_int_non_negative)
+    call amg_check_def(lv%parms%sweeps_post,&
+         & 'Jacobi sweeps',izero,is_int_non_negative)
+    
+    call lv%sm%build(lv%base_a,lv%base_desc,info)
+    if (info == 0) then
+      if (allocated(lv%sm2a)) then 
+        call lv%sm2a%build(lv%base_a,lv%base_desc,info)
+        lv%sm2 => lv%sm2a
+      else
+        lv%sm2 => lv%sm
+      end if
+    end if
+    if (info /=0 ) then
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,&
+           & a_err='Smoother bld error')
+      goto 9999
+    end if
+    
+    if (lv%sm%sv%is_global()) then
+      if ((lv%parms%sweeps_pre>1).or.(lv%parms%sweeps_post>1)) then
+        lv%parms%sweeps_pre  = 1
+        lv%parms%sweeps_post = 1
+        if (me == 0) then
+          write(debug_unit,*) 
+          if (present(ilv)) then
+            write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
+                 & '" at level ',ilv
+            write(debug_unit,*) '         is configured as a global solver '
+          else
+            write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
+                 & '" is configured as a global solver '
+          end if
+          write(debug_unit,*) '        Pre and post sweeps at this level reset to 1'
         end if
-        write(debug_unit,*) '        Pre and post sweeps at this level reset to 1'
       end if
     end if
   end if

amgprec/impl/level/amg_d_base_onelev_cnv.f90

@@ -62,6 +62,6 @@ subroutine amg_d_base_onelev_cnv(lv,info,amold,vmold,imold)
          & call lv%ac%cscnv(info,mold=amold)
     if (info == psb_success_ .and. lv%desc_ac%is_ok() &
          & .and. present(imold)) call lv%desc_ac%cnv(imold)
-    if (info == psb_success_) call lv%map%cnv(info,mold=amold,imold=imold)
+    if (info == psb_success_) call lv%linmap%cnv(info,mold=amold,imold=imold)
   end if
 end subroutine amg_d_base_onelev_cnv

amgprec/impl/level/amg_d_base_onelev_csetc.F90

@@ -1,15 +1,15 @@
-!  
-!   
+!
+!
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
 !               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!    
-!    (C) Copyright 2020 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
+!
+!    (C) Copyright 2020
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
 !    are met:
@@ -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,10 +33,10 @@
 !    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.
-!   
-!  
+!
+!
 subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
-  
+
   use psb_base_mod
   use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_csetc
   use amg_d_base_aggregator_mod
@@ -49,6 +49,9 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
   use amg_d_ilu_solver
   use amg_d_id_solver
   use amg_d_gs_solver
+  use amg_d_ainv_solver
+  use amg_d_invk_solver
+  use amg_d_invt_solver
 #if defined(HAVE_UMF_)
   use amg_d_umf_solver
 #endif
@@ -65,16 +68,16 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
   Implicit None
 
   ! Arguments
-  class(amg_d_onelev_type), intent(inout) :: lv 
-  character(len=*), intent(in)              :: what 
+  class(amg_d_onelev_type), intent(inout) :: lv
+  character(len=*), intent(in)              :: what
   character(len=*), intent(in)              :: val
   integer(psb_ipk_), intent(out)            :: info
   character(len=*), optional, intent(in)    :: pos
   integer(psb_ipk_), intent(in), optional   :: idx
-  ! Local 
+  ! Local
   integer(psb_ipk_)  :: ipos_, err_act
   character(len=20) :: name='d_base_onelev_csetc'
-  integer(psb_ipk_) :: ival 
+  integer(psb_ipk_) :: ival
   type(amg_d_base_smoother_type)   :: amg_d_base_smoother_mold
   type(amg_d_jac_smoother_type)    ::  amg_d_jac_smoother_mold
   type(amg_d_l1_jac_smoother_type) ::  amg_d_l1_jac_smoother_mold
@@ -85,6 +88,9 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
   type(amg_d_id_solver_type)       ::  amg_d_id_solver_mold
   type(amg_d_gs_solver_type)       ::  amg_d_gs_solver_mold
   type(amg_d_bwgs_solver_type)     ::  amg_d_bwgs_solver_mold
+  type(amg_d_ainv_solver_type)     ::  amg_d_ainv_solver_mold
+  type(amg_d_invk_solver_type)     ::  amg_d_invk_solver_mold
+  type(amg_d_invt_solver_type)     ::  amg_d_invt_solver_mold
 #if defined(HAVE_UMF_)
   type(amg_d_umf_solver_type)     ::  amg_d_umf_solver_mold
 #endif
@@ -97,7 +103,7 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
 #if defined(HAVE_MUMPS_)
   type(amg_d_mumps_solver_type) ::  amg_d_mumps_solver_mold
 #endif
-  
+
 
   call psb_erractionsave(err_act)
 
@@ -118,14 +124,14 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
   else
     ipos_ = amg_smooth_both_
   end if
-  
+
   select case (psb_toupper(trim(what)))
   case ('SMOOTHER_TYPE')
     select case (psb_toupper(trim(val)))
     case ('NOPREC','NONE')
       call lv%set(amg_d_base_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_d_id_solver_mold,info,pos=pos)
-      
+
     case ('JAC','JACOBI')
       call lv%set(amg_d_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_d_diag_solver_mold,info,pos=pos)
@@ -133,11 +139,11 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
     case ('L1-JACOBI')
       call lv%set(amg_d_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_d_l1_diag_solver_mold,info,pos=pos)
-      
+
     case ('BJAC')
       call lv%set(amg_d_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_d_ilu_solver_mold,info,pos=pos)
-      
+
     case ('L1-BJAC')
       call lv%set(amg_d_l1_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_d_ilu_solver_mold,info,pos=pos)
@@ -166,59 +172,65 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
     case ('L1-BWGS')
       call lv%set(amg_d_l1_jac_smoother_mold,info,pos='pre')
       if (info == 0) call lv%set(amg_d_bwgs_solver_mold,info,pos='pre')
-      if (allocated(lv%sm2a)) deallocate(lv%sm2a)      
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
     case ('L1-FBGS')
       call lv%set(amg_d_l1_jac_smoother_mold,info,pos='pre')
       if (info == 0) call lv%set(amg_d_gs_solver_mold,info,pos='pre')
       call lv%set(amg_d_l1_jac_smoother_mold,info,pos='post')
       if (info == 0) call lv%set(amg_d_bwgs_solver_mold,info,pos='post')
-      
+
     case default
       !
-      ! Do nothing and hope for the best :) 
+      ! Do nothing and hope for the best :)
       !
     end select
-    if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then 
+    if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
       if (allocated(lv%sm)) call lv%sm%default()
     end if
     if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then
       if (allocated(lv%sm2a)) call lv%sm2a%default()
     end if
-    
+
 
   case('SUB_SOLVE')
     select case (psb_toupper(trim(val)))
     case ('NONE','NOPREC','FACT_NONE')
       call lv%set(amg_d_id_solver_mold,info,pos=pos)
-      
+
     case ('DIAG')
       call lv%set(amg_d_diag_solver_mold,info,pos=pos)
-      
+
     case ('L1-DIAG')
       call lv%set(amg_d_l1_diag_solver_mold,info,pos=pos)
-      
+
     case ('GS','FGS','FWGS')
       call lv%set(amg_d_gs_solver_mold,info,pos=pos)
-      
+
     case ('BGS','BWGS')
       call lv%set(amg_d_bwgs_solver_mold,info,pos=pos)
-      
+
+    case ('AINV')
+      call lv%set(amg_d_ainv_solver_mold,info,pos=pos)
+    case ('INVK')
+      call lv%set(amg_d_invk_solver_mold,info,pos=pos)
+    case ('INVT')
+      call lv%set(amg_d_invt_solver_mold,info,pos=pos)
     case ('ILU','ILUT','MILU')
       call lv%set(amg_d_ilu_solver_mold,info,pos=pos)
       if (info == 0) then
-        if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then 
+        if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
           call lv%sm%sv%set('SUB_SOLVE',val,info)
         end if
-        if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then 
+        if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
           if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
         end if
       end if
 #ifdef HAVE_SLU_
-    case ('SLU') 
+    case ('SLU')
       call lv%set(amg_d_slu_solver_mold,info,pos=pos)
 #endif
 #ifdef HAVE_MUMPS_
-    case ('MUMPS') 
+    case ('MUMPS')
       call lv%set(amg_d_mumps_solver_mold,info,pos=pos)
 #endif
 #ifdef HAVE_SLUDIST_
@@ -231,10 +243,10 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
 #endif
     case default
       !
-      ! Do nothing and hope for the best :) 
+      ! Do nothing and hope for the best :)
       !
     end select
-    
+
   case ('ML_CYCLE')
     lv%parms%ml_cycle      = amg_stringval(val)
 
@@ -249,7 +261,7 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
         return
       end if
     end if
-    
+
     select case(ival)
     case(amg_dec_aggr_)
       allocate(amg_d_dec_aggregator_type :: lv%aggr, stat=info)
@@ -259,7 +271,7 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
       info =  psb_err_internal_error_
     end select
     if (info == psb_success_) call lv%aggr%default()
-    
+
   case ('AGGR_ORD')
     lv%parms%aggr_ord      = amg_stringval(val)
 
@@ -286,13 +298,13 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
     lv%parms%coarse_solve    = amg_stringval(val)
 
   case default
-    if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then 
-      if (allocated(lv%sm)) then 
+    if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
+      if (allocated(lv%sm)) then
         call lv%sm%set(what,val,info,idx=idx)
       end if
     end if
-    if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then 
-      if (allocated(lv%sm2a)) then 
+    if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
+      if (allocated(lv%sm2a)) then
         call lv%sm2a%set(what,val,info,idx=idx)
       end if
     end if

amgprec/impl/level/amg_d_base_onelev_descr.f90

@@ -35,21 +35,30 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout)
+!
+!
+! verbosity:
+!        <0: suppress all messages
+!         0: normal
+!        >1: increased details 
+!
+subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity)
   
   use psb_base_mod
   use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_descr
   Implicit None
   ! Arguments
-  class(amg_d_onelev_type), intent(in)  :: lv
+  class(amg_d_onelev_type), intent(in)    :: lv
   integer(psb_ipk_), intent(in)           :: il,nl,ilmin
   integer(psb_ipk_), intent(out)          :: info
   integer(psb_ipk_), intent(in), optional :: iout
+  integer(psb_ipk_), intent(in), optional :: verbosity
+
 
   ! Local variables
-  integer(psb_ipk_)      :: err_act
+  integer(psb_ipk_)  :: err_act
   character(len=20), parameter :: name='amg_d_base_onelev_descr'
-  integer(psb_ipk_)      :: iout_
+  integer(psb_ipk_)  :: iout_, verbosity_
   logical      :: coarse
 
 
@@ -63,6 +72,13 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout)
   else 
     iout_ = psb_out_unit
   end if
+  
+  if (present(verbosity)) then
+    verbosity_ = verbosity
+  else
+    verbosity_ = 0
+  end if
+  if (verbosity_ < 0) goto 9998
 
   write(iout_,*) 
   if (il == ilmin) then 
@@ -89,12 +105,22 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout)
     call lv%parms%descr(iout_,info,coarse=coarse)
 
     if (nl > 1) then 
-      if (allocated(lv%map%naggr)) then
+      if (allocated(lv%linmap%naggr)) then
         write(iout_,*) '  Coarse Matrix: Global size: ', &
-             &  sum((1_psb_lpk_*lv%map%naggr(:))),' Nonzeros: ',lv%ac_nz_tot
-        write(iout_,*) '          Local matrix sizes: ', &
-             &  lv%map%naggr(:)
-        write(iout_,*) '  Aggregation   ratio: ', &
+             &  lv%linmap%nagtot
+        write(iout_,*) '                    Nonzeros: ',lv%ac_nz_tot
+        if (verbosity_>0) then
+          write(iout_,*) '          Local matrix sizes: ', &
+               &  lv%linmap%naggr(:)
+        else 
+          write(iout_,'(2(a,1x,i12))') &
+               & '     Local  matrix sizes: min:', &
+               & lv%linmap%nagmin,'         max:', lv%linmap%nagmax
+          write(iout_,'(a,1x,f14.1)') &
+               & '                          avg:', &
+               & lv%linmap%nagavg
+        end if
+        write(iout_,'(a,1x,f14.2)') '          Aggregation   ratio: ', &
              &  lv%szratio
       end if
     end if
@@ -102,7 +128,8 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout)
     if (coarse.and.allocated(lv%sm)) &
          & call lv%sm%descr(info,iout=iout_,coarse=coarse)
   end if
-  
+
+9998 continue
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/level/amg_d_base_onelev_dump.f90

@@ -108,17 +108,17 @@ subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
         call lv%ac%print(fname,head=head,iv=ivr)
       end if
       if (rp_) then 
-        ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
-        ivc = lv%map%p_desc_V%get_global_indices(owned=.false.)
+        ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
+        ivc = lv%linmap%p_desc_V%get_global_indices(owned=.false.)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
-        call lv%map%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
+        call lv%linmap%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
-        call lv%map%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
+        call lv%linmap%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
       end if
       if (tprol_) then
         ! Tentative prolongator is stored with column indices already
         ! in global numbering, so only IVR is needed. 
-        ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
+        ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'
         !
         !  This is not implemented yet.
@@ -133,9 +133,9 @@ subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
       end if
       if (rp_) then 
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
-        call lv%map%mat_U2V%print(fname,head=head)
+        call lv%linmap%mat_U2V%print(fname,head=head)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
-        call lv%map%mat_V2U%print(fname,head=head)
+        call lv%linmap%mat_V2U%print(fname,head=head)
       end if
       if (tprol_) then 
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'

amgprec/impl/level/amg_d_base_onelev_free.f90

@@ -63,7 +63,7 @@ subroutine amg_d_base_onelev_free(lv,info)
   call lv%ac%free()
   if (lv%desc_ac%is_ok()) &
        & call lv%desc_ac%free(info)
-  call lv%map%free(info)
+  call lv%linmap%free(info)
 
   ! This is a pointer to something else, must not free it here. 
   nullify(lv%base_a) 

amgprec/impl/level/amg_d_base_onelev_map_prol.F90

@@ -0,0 +1,135 @@
+!  
+!   
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2020 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
+  use psb_base_mod
+  use amg_d_onelev_mod, amg_protect_name =>  amg_d_base_onelev_map_prol_v
+  
+  implicit none
+  class(amg_d_onelev_type), target, intent(inout) :: lv
+  real(psb_dpk_), intent(in)           :: alpha, beta
+  type(psb_d_vect_type), intent(inout) :: vect_u, vect_v
+  integer(psb_ipk_), intent(out)       :: info
+  real(psb_dpk_), optional          :: work(:)
+  type(psb_d_vect_type), optional, target, intent(inout)  :: vtx,vty
+  
+!!$  write(0,*) 'New map_prol',lv%remap_data%ac_pre_remap%is_asb()
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+!!$    write(0,*) 'Remap handling '
+    block
+      type(psb_ctxt_type) :: ctxt, nctxt
+      integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
+      integer(psb_ipk_) :: me, np,  rme, rnp
+      real(psb_dpk_), allocatable :: rsnd(:), rrcv(:)
+      type(psb_d_vect_type) :: tv
+
+      ctxt = lv%remap_data%desc_ac_pre_remap%get_ctxt()
+      call psb_info(ctxt,me,np)
+!!$      write(0,*) 'Old context ',me,np,psb_errstatus_fatal()
+      nctxt = lv%desc_ac%get_ctxt()
+      call psb_info(nctxt,rme,rnp)
+!!$      write(0,*) 'New context ',rme,rnp,psb_errstatus_fatal()
+      idest = lv%remap_data%idest
+      associate(isrc => lv%remap_data%isrc, nrsrc => lv%remap_data%nrsrc)
+!!$        write(0,*) 'Should apply maps, then receive data from ',idest,' to ',me,psb_errstatus_fatal()
+        nsrc = size(isrc)
+        nrl  = lv%remap_data%desc_ac_pre_remap%get_local_rows()
+        nrc  = lv%remap_data%desc_ac_pre_remap%get_local_cols()
+        if (rme >=0) then
+          allocate(rrcv(sum(nrsrc)))
+          rrcv   = vect_v%get_vect()
+!!$          write(0,*) me,rme,' Size check ',size(rrcv),lv%desc_ac%get_local_rows(),psb_errstatus_fatal()
+          kp = 0
+          do i = 1,size(isrc)
+            ip = isrc(i)
+            nrl = nrsrc(i)
+!!$            write(0,*) me,' Sending to ',ip,nrl,kp+1,kp+nrl
+            call psb_snd(ctxt,rrcv(kp+1:kp+nrl),ip)
+            kp = kp + nrl
+          end do
+        end if
+        nrl = lv%remap_data%desc_ac_pre_remap%get_local_rows()
+        call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info)
+!!$        write(0,*) me, ' Allocated ',nrl,info,psb_errstatus_fatal()
+        
+        call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) 
+!!$        write(0,*) me,' Size of TV ',nrl,tv%get_nrows(),info
+!!$        write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal()
+        call psb_realloc(nrc,rsnd,info)
+        call psb_rcv(ctxt,rsnd(1:nrl),idest)
+        call tv%set_vect(rsnd)
+        call lv%linmap%map_V2U(alpha,tv,beta,vect_u,info,&
+             & work=work,vtx=vtx,vty=vty)
+      end associate
+!!$      write(0,*) me, ' Prolongator with remap done '
+!!$      flush(0)
+!!$      call psb_barrier(ctxt)
+    end block
+  else
+    ! Default transfer
+    call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,&
+         & work=work,vtx=vtx,vty=vty)
+  end if
+  
+end subroutine amg_d_base_onelev_map_prol_v
+
+subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
+  use psb_base_mod
+  use amg_d_onelev_mod, amg_protect_name =>  amg_d_base_onelev_map_prol_a
+  implicit none
+  class(amg_d_onelev_type), target, intent(inout) :: lv
+  real(psb_dpk_), intent(in)     :: alpha, beta
+  real(psb_dpk_), intent(inout)   :: u(:)
+  real(psb_dpk_), intent(out)     :: v(:)
+  integer(psb_ipk_), intent(out) :: info
+  real(psb_dpk_), optional          :: work(:)
+
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+    write(0,*) 'Remap handling not implemented yet '
+  else
+    ! Default transfer
+    call lv%linmap%map_V2U(alpha,v,beta,u,info,&
+         & work=work)
+  end if
+  
+end subroutine amg_d_base_onelev_map_prol_a

amgprec/impl/level/amg_d_base_onelev_map_rstr.F90

@@ -0,0 +1,129 @@
+!  
+!   
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2020 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+
+subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
+     &  work,vtx,vty)
+  use psb_base_mod
+  use amg_d_onelev_mod, amg_protect_name =>  amg_d_base_onelev_map_rstr_v
+  implicit none
+  class(amg_d_onelev_type), target, intent(inout) :: lv
+  real(psb_dpk_), intent(in)           :: alpha, beta
+  type(psb_d_vect_type), intent(inout) :: vect_u, vect_v
+  integer(psb_ipk_), intent(out)       :: info
+  real(psb_dpk_), optional          :: work(:)
+  type(psb_d_vect_type), optional, target, intent(inout)  :: vtx,vty
+
+!!$  write(0,*) 'New map_rstr',lv%remap_data%ac_pre_remap%is_asb()
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+!!$    write(0,*) 'Remap handling not implemented yet '
+    block
+      type(psb_ctxt_type) :: ctxt, nctxt
+      integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp
+      integer(psb_ipk_) :: me, np,  rme, rnp
+      real(psb_dpk_), allocatable :: rsnd(:), rrcv(:)
+      type(psb_d_vect_type) :: tv
+      
+      ctxt = lv%remap_data%desc_ac_pre_remap%get_ctxt()
+      call psb_info(ctxt,me,np)
+      nctxt = lv%desc_ac%get_ctxt()
+      call psb_info(nctxt,rme,rnp)
+!!$      write(0,*) 'New context ',rme,rnp
+      idest = lv%remap_data%idest
+      associate(isrc => lv%remap_data%isrc, nrsrc => lv%remap_data%nrsrc)
+!!$        write(0,*) 'Should apply maps, then send data from ',me,' to ',idest
+!!$        if (rme >= 0) write(0,*) rme, '  Receiving      data from ',isrc(:)
+        nsrc = size(isrc)
+        nrl  = lv%remap_data%desc_ac_pre_remap%get_local_rows()
+        call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info)
+        call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) 
+!!$        write(0,*) me,' Size of TV ',tv%get_nrows()
+        call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,&
+             & work=work,vtx=vtx,vty=vty)
+        rsnd = tv%get_vect()
+        call psb_snd(ctxt,rsnd(1:nrl),idest)
+        if (rme >=0) then
+          allocate(rrcv(sum(nrsrc)))
+!!$          write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows()
+          kp = 0
+          do i = 1,size(isrc)
+            ip = isrc(i)
+            nrl = nrsrc(i)
+!!$            write(0,*) me,' Receiving from ',ip,nrl,kp+1,kp+nrl,size(rrcv)
+            call psb_rcv(ctxt,rrcv(kp+1:kp+nrl),ip)
+            kp = kp + nrl
+          end do
+          call vect_v%set_vect(rrcv)
+        end if
+      end associate
+!!$      write(0,*) me, ' Restrictor with remap done '
+    end block
+ 
+  else
+    ! Default transfer
+    call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,&
+         & work=work,vtx=vtx,vty=vty)
+  end if
+  
+end subroutine amg_d_base_onelev_map_rstr_v
+
+subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
+  use psb_base_mod
+  use amg_d_onelev_mod, amg_protect_name =>  amg_d_base_onelev_map_rstr_a
+  implicit none
+  class(amg_d_onelev_type), target, intent(inout) :: lv
+  real(psb_dpk_), intent(in)     :: alpha, beta
+  real(psb_dpk_), intent(inout)   :: u(:)
+  real(psb_dpk_), intent(out)     :: v(:)
+  integer(psb_ipk_), intent(out) :: info
+  real(psb_dpk_), optional       :: work(:)
+
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+    write(0,*) 'Remap handling not implemented yet '
+  else
+    ! Default transfer
+    call lv%linmap%map_U2V(alpha,u,beta,v,info,&
+         & work=work)
+  end if
+  
+end subroutine amg_d_base_onelev_map_rstr_a

amgprec/impl/level/amg_d_base_onelev_mat_asb.f90

@@ -53,7 +53,7 @@
 !  2. Call amg_Xaggrmat_asb to compute prolongator/restrictor/AC
 !  3. According to the choice of DIST/REPL for AC, build a descriptor DESC_AC,
 !     and adjust the column numbering of AC/OP_PROL/OP_RESTR
-!  4. Pack restrictor and prolongator into p%map
+!  4. Pack restrictor and prolongator into p%linmap
 !  5. Fix base_a and base_desc pointers.
 !
 ! 
@@ -158,7 +158,7 @@ subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
   
   if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,&
-       & ilaggr,nlaggr,op_restr,op_prol,lv%map,info)
+       & ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info)
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld')
     goto 9999

amgprec/impl/level/amg_s_base_onelev_build.f90

@@ -71,72 +71,81 @@ subroutine amg_s_base_onelev_build(lv,info,amold,vmold,imold,ilv)
   ctxt = lv%base_desc%get_ctxt()
   call psb_info(ctxt,me,np)
 
-  if (.not.allocated(lv%sm)) then 
-    !! Error: should have called amg_dprecinit
-    info=3111
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-  if (.not.allocated(lv%sm%sv)) then 
-    !! Error: should have called amg_dprecinit
-    info=3111
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-  lv%ac_nz_loc = lv%ac%get_nzeros()
-  lv%ac_nz_tot = lv%ac_nz_loc
-  select case(lv%parms%coarse_mat)
-  case(amg_distr_mat_) 
-    call psb_sum(ctxt,lv%ac_nz_tot)
-  case(amg_repl_mat_)
-    ! Do nothing
-  case default
-    ! Should never get here
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='Wrong lv%parms')
-    goto 9999
-  end select
-  
-  
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Calling mlprcbld at level  ',i
-  call amg_check_def(lv%parms%sweeps_pre,&
-       & 'Jacobi sweeps',izero,is_int_non_negative)
-  call amg_check_def(lv%parms%sweeps_post,&
-       & 'Jacobi sweeps',izero,is_int_non_negative)
-
-  call lv%sm%build(lv%base_a,lv%base_desc,info)
-  if (info == 0) then
-    if (allocated(lv%sm2a)) then 
-      call lv%sm2a%build(lv%base_a,lv%base_desc,info)
-      lv%sm2 => lv%sm2a
-    else
-      lv%sm2 => lv%sm
+  !
+  ! At top level(s) I may be using
+  ! a context with less processes
+  !
+  if (me < 0) then
+!!$    write(0,*) 'onelevbld: I am excluded from this one '
+  else
+!!$    write(0,*) me,' Going to build smoothers at this level '
+    if (.not.allocated(lv%sm)) then 
+      !! Error: should have called amg_dprecinit
+      info=3111
+      call psb_errpush(info,name)
+      goto 9999
     end if
-  end if
-  if (info /=0 ) then
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,&
-         & a_err='Smoother bld error')
-    goto 9999
-  end if
-
-  if (lv%sm%sv%is_global()) then
-    if ((lv%parms%sweeps_pre>1).or.(lv%parms%sweeps_post>1)) then
-      lv%parms%sweeps_pre  = 1
-      lv%parms%sweeps_post = 1
-      if (me == 0) then
-        write(debug_unit,*) 
-        if (present(ilv)) then
-          write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
-               & '" at level ',ilv
-          write(debug_unit,*) '         is configured as a global solver '
-        else
-          write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
-               & '" is configured as a global solver '
+    if (.not.allocated(lv%sm%sv)) then 
+      !! Error: should have called amg_dprecinit
+      info=3111
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+    lv%ac_nz_loc = lv%ac%get_nzeros()
+    lv%ac_nz_tot = lv%ac_nz_loc
+    select case(lv%parms%coarse_mat)
+    case(amg_distr_mat_) 
+      call psb_sum(ctxt,lv%ac_nz_tot)
+    case(amg_repl_mat_)
+      ! Do nothing
+    case default
+      ! Should never get here
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,a_err='Wrong lv%parms')
+      goto 9999
+    end select
+    
+    
+    if (debug_level >= psb_debug_outer_) &
+         & write(debug_unit,*) me,' ',trim(name),&
+         & 'Calling mlprcbld at level  ',i
+    call amg_check_def(lv%parms%sweeps_pre,&
+         & 'Jacobi sweeps',izero,is_int_non_negative)
+    call amg_check_def(lv%parms%sweeps_post,&
+         & 'Jacobi sweeps',izero,is_int_non_negative)
+    
+    call lv%sm%build(lv%base_a,lv%base_desc,info)
+    if (info == 0) then
+      if (allocated(lv%sm2a)) then 
+        call lv%sm2a%build(lv%base_a,lv%base_desc,info)
+        lv%sm2 => lv%sm2a
+      else
+        lv%sm2 => lv%sm
+      end if
+    end if
+    if (info /=0 ) then
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,&
+           & a_err='Smoother bld error')
+      goto 9999
+    end if
+    
+    if (lv%sm%sv%is_global()) then
+      if ((lv%parms%sweeps_pre>1).or.(lv%parms%sweeps_post>1)) then
+        lv%parms%sweeps_pre  = 1
+        lv%parms%sweeps_post = 1
+        if (me == 0) then
+          write(debug_unit,*) 
+          if (present(ilv)) then
+            write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
+                 & '" at level ',ilv
+            write(debug_unit,*) '         is configured as a global solver '
+          else
+            write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
+                 & '" is configured as a global solver '
+          end if
+          write(debug_unit,*) '        Pre and post sweeps at this level reset to 1'
         end if
-        write(debug_unit,*) '        Pre and post sweeps at this level reset to 1'
       end if
     end if
   end if

amgprec/impl/level/amg_s_base_onelev_cnv.f90

@@ -62,6 +62,6 @@ subroutine amg_s_base_onelev_cnv(lv,info,amold,vmold,imold)
          & call lv%ac%cscnv(info,mold=amold)
     if (info == psb_success_ .and. lv%desc_ac%is_ok() &
          & .and. present(imold)) call lv%desc_ac%cnv(imold)
-    if (info == psb_success_) call lv%map%cnv(info,mold=amold,imold=imold)
+    if (info == psb_success_) call lv%linmap%cnv(info,mold=amold,imold=imold)
   end if
 end subroutine amg_s_base_onelev_cnv

amgprec/impl/level/amg_s_base_onelev_csetc.F90

@@ -1,15 +1,15 @@
-!  
-!   
+!
+!
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
 !               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!    
-!    (C) Copyright 2020 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
+!
+!    (C) Copyright 2020
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
 !    are met:
@@ -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,10 +33,10 @@
 !    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.
-!   
-!  
+!
+!
 subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
-  
+
   use psb_base_mod
   use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_csetc
   use amg_s_base_aggregator_mod
@@ -49,6 +49,9 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
   use amg_s_ilu_solver
   use amg_s_id_solver
   use amg_s_gs_solver
+  use amg_s_ainv_solver
+  use amg_s_invk_solver
+  use amg_s_invt_solver
 #if defined(HAVE_SLU_)
   use amg_s_slu_solver
 #endif
@@ -59,16 +62,16 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
   Implicit None
 
   ! Arguments
-  class(amg_s_onelev_type), intent(inout) :: lv 
-  character(len=*), intent(in)              :: what 
+  class(amg_s_onelev_type), intent(inout) :: lv
+  character(len=*), intent(in)              :: what
   character(len=*), intent(in)              :: val
   integer(psb_ipk_), intent(out)            :: info
   character(len=*), optional, intent(in)    :: pos
   integer(psb_ipk_), intent(in), optional   :: idx
-  ! Local 
+  ! Local
   integer(psb_ipk_)  :: ipos_, err_act
   character(len=20) :: name='s_base_onelev_csetc'
-  integer(psb_ipk_) :: ival 
+  integer(psb_ipk_) :: ival
   type(amg_s_base_smoother_type)   :: amg_s_base_smoother_mold
   type(amg_s_jac_smoother_type)    ::  amg_s_jac_smoother_mold
   type(amg_s_l1_jac_smoother_type) ::  amg_s_l1_jac_smoother_mold
@@ -79,13 +82,16 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
   type(amg_s_id_solver_type)       ::  amg_s_id_solver_mold
   type(amg_s_gs_solver_type)       ::  amg_s_gs_solver_mold
   type(amg_s_bwgs_solver_type)     ::  amg_s_bwgs_solver_mold
+  type(amg_s_ainv_solver_type)     ::  amg_s_ainv_solver_mold
+  type(amg_s_invk_solver_type)     ::  amg_s_invk_solver_mold
+  type(amg_s_invt_solver_type)     ::  amg_s_invt_solver_mold
 #if defined(HAVE_SLU_)
   type(amg_s_slu_solver_type)   ::  amg_s_slu_solver_mold
 #endif
 #if defined(HAVE_MUMPS_)
   type(amg_s_mumps_solver_type) ::  amg_s_mumps_solver_mold
 #endif
-  
+
 
   call psb_erractionsave(err_act)
 
@@ -106,14 +112,14 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
   else
     ipos_ = amg_smooth_both_
   end if
-  
+
   select case (psb_toupper(trim(what)))
   case ('SMOOTHER_TYPE')
     select case (psb_toupper(trim(val)))
     case ('NOPREC','NONE')
       call lv%set(amg_s_base_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_s_id_solver_mold,info,pos=pos)
-      
+
     case ('JAC','JACOBI')
       call lv%set(amg_s_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_s_diag_solver_mold,info,pos=pos)
@@ -121,11 +127,11 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
     case ('L1-JACOBI')
       call lv%set(amg_s_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_s_l1_diag_solver_mold,info,pos=pos)
-      
+
     case ('BJAC')
       call lv%set(amg_s_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_s_ilu_solver_mold,info,pos=pos)
-      
+
     case ('L1-BJAC')
       call lv%set(amg_s_l1_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_s_ilu_solver_mold,info,pos=pos)
@@ -154,67 +160,73 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
     case ('L1-BWGS')
       call lv%set(amg_s_l1_jac_smoother_mold,info,pos='pre')
       if (info == 0) call lv%set(amg_s_bwgs_solver_mold,info,pos='pre')
-      if (allocated(lv%sm2a)) deallocate(lv%sm2a)      
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
     case ('L1-FBGS')
       call lv%set(amg_s_l1_jac_smoother_mold,info,pos='pre')
       if (info == 0) call lv%set(amg_s_gs_solver_mold,info,pos='pre')
       call lv%set(amg_s_l1_jac_smoother_mold,info,pos='post')
       if (info == 0) call lv%set(amg_s_bwgs_solver_mold,info,pos='post')
-      
+
     case default
       !
-      ! Do nothing and hope for the best :) 
+      ! Do nothing and hope for the best :)
       !
     end select
-    if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then 
+    if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
       if (allocated(lv%sm)) call lv%sm%default()
     end if
     if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then
       if (allocated(lv%sm2a)) call lv%sm2a%default()
     end if
-    
+
 
   case('SUB_SOLVE')
     select case (psb_toupper(trim(val)))
     case ('NONE','NOPREC','FACT_NONE')
       call lv%set(amg_s_id_solver_mold,info,pos=pos)
-      
+
     case ('DIAG')
       call lv%set(amg_s_diag_solver_mold,info,pos=pos)
-      
+
     case ('L1-DIAG')
       call lv%set(amg_s_l1_diag_solver_mold,info,pos=pos)
-      
+
     case ('GS','FGS','FWGS')
       call lv%set(amg_s_gs_solver_mold,info,pos=pos)
-      
+
     case ('BGS','BWGS')
       call lv%set(amg_s_bwgs_solver_mold,info,pos=pos)
-      
+
+    case ('AINV')
+      call lv%set(amg_s_ainv_solver_mold,info,pos=pos)
+    case ('INVK')
+      call lv%set(amg_s_invk_solver_mold,info,pos=pos)
+    case ('INVT')
+      call lv%set(amg_s_invt_solver_mold,info,pos=pos)
     case ('ILU','ILUT','MILU')
       call lv%set(amg_s_ilu_solver_mold,info,pos=pos)
       if (info == 0) then
-        if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then 
+        if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
           call lv%sm%sv%set('SUB_SOLVE',val,info)
         end if
-        if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then 
+        if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
           if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
         end if
       end if
 #ifdef HAVE_SLU_
-    case ('SLU') 
+    case ('SLU')
       call lv%set(amg_s_slu_solver_mold,info,pos=pos)
 #endif
 #ifdef HAVE_MUMPS_
-    case ('MUMPS') 
+    case ('MUMPS')
       call lv%set(amg_s_mumps_solver_mold,info,pos=pos)
 #endif
     case default
       !
-      ! Do nothing and hope for the best :) 
+      ! Do nothing and hope for the best :)
       !
     end select
-    
+
   case ('ML_CYCLE')
     lv%parms%ml_cycle      = amg_stringval(val)
 
@@ -229,7 +241,7 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
         return
       end if
     end if
-    
+
     select case(ival)
     case(amg_dec_aggr_)
       allocate(amg_s_dec_aggregator_type :: lv%aggr, stat=info)
@@ -239,7 +251,7 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
       info =  psb_err_internal_error_
     end select
     if (info == psb_success_) call lv%aggr%default()
-    
+
   case ('AGGR_ORD')
     lv%parms%aggr_ord      = amg_stringval(val)
 
@@ -266,13 +278,13 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
     lv%parms%coarse_solve    = amg_stringval(val)
 
   case default
-    if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then 
-      if (allocated(lv%sm)) then 
+    if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
+      if (allocated(lv%sm)) then
         call lv%sm%set(what,val,info,idx=idx)
       end if
     end if
-    if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then 
-      if (allocated(lv%sm2a)) then 
+    if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
+      if (allocated(lv%sm2a)) then
         call lv%sm2a%set(what,val,info,idx=idx)
       end if
     end if

amgprec/impl/level/amg_s_base_onelev_descr.f90

@@ -35,21 +35,30 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout)
+!
+!
+! verbosity:
+!        <0: suppress all messages
+!         0: normal
+!        >1: increased details 
+!
+subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity)
   
   use psb_base_mod
   use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_descr
   Implicit None
   ! Arguments
-  class(amg_s_onelev_type), intent(in)  :: lv
+  class(amg_s_onelev_type), intent(in)    :: lv
   integer(psb_ipk_), intent(in)           :: il,nl,ilmin
   integer(psb_ipk_), intent(out)          :: info
   integer(psb_ipk_), intent(in), optional :: iout
+  integer(psb_ipk_), intent(in), optional :: verbosity
+
 
   ! Local variables
-  integer(psb_ipk_)      :: err_act
+  integer(psb_ipk_)  :: err_act
   character(len=20), parameter :: name='amg_s_base_onelev_descr'
-  integer(psb_ipk_)      :: iout_
+  integer(psb_ipk_)  :: iout_, verbosity_
   logical      :: coarse
 
 
@@ -63,6 +72,13 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout)
   else 
     iout_ = psb_out_unit
   end if
+  
+  if (present(verbosity)) then
+    verbosity_ = verbosity
+  else
+    verbosity_ = 0
+  end if
+  if (verbosity_ < 0) goto 9998
 
   write(iout_,*) 
   if (il == ilmin) then 
@@ -89,12 +105,22 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout)
     call lv%parms%descr(iout_,info,coarse=coarse)
 
     if (nl > 1) then 
-      if (allocated(lv%map%naggr)) then
+      if (allocated(lv%linmap%naggr)) then
         write(iout_,*) '  Coarse Matrix: Global size: ', &
-             &  sum((1_psb_lpk_*lv%map%naggr(:))),' Nonzeros: ',lv%ac_nz_tot
-        write(iout_,*) '          Local matrix sizes: ', &
-             &  lv%map%naggr(:)
-        write(iout_,*) '  Aggregation   ratio: ', &
+             &  lv%linmap%nagtot
+        write(iout_,*) '                    Nonzeros: ',lv%ac_nz_tot
+        if (verbosity_>0) then
+          write(iout_,*) '          Local matrix sizes: ', &
+               &  lv%linmap%naggr(:)
+        else 
+          write(iout_,'(2(a,1x,i12))') &
+               & '     Local  matrix sizes: min:', &
+               & lv%linmap%nagmin,'         max:', lv%linmap%nagmax
+          write(iout_,'(a,1x,f14.1)') &
+               & '                          avg:', &
+               & lv%linmap%nagavg
+        end if
+        write(iout_,'(a,1x,f14.2)') '          Aggregation   ratio: ', &
              &  lv%szratio
       end if
     end if
@@ -102,7 +128,8 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout)
     if (coarse.and.allocated(lv%sm)) &
          & call lv%sm%descr(info,iout=iout_,coarse=coarse)
   end if
-  
+
+9998 continue
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/level/amg_s_base_onelev_dump.f90

@@ -108,17 +108,17 @@ subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
         call lv%ac%print(fname,head=head,iv=ivr)
       end if
       if (rp_) then 
-        ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
-        ivc = lv%map%p_desc_V%get_global_indices(owned=.false.)
+        ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
+        ivc = lv%linmap%p_desc_V%get_global_indices(owned=.false.)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
-        call lv%map%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
+        call lv%linmap%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
-        call lv%map%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
+        call lv%linmap%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
       end if
       if (tprol_) then
         ! Tentative prolongator is stored with column indices already
         ! in global numbering, so only IVR is needed. 
-        ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
+        ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'
         !
         !  This is not implemented yet.
@@ -133,9 +133,9 @@ subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
       end if
       if (rp_) then 
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
-        call lv%map%mat_U2V%print(fname,head=head)
+        call lv%linmap%mat_U2V%print(fname,head=head)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
-        call lv%map%mat_V2U%print(fname,head=head)
+        call lv%linmap%mat_V2U%print(fname,head=head)
       end if
       if (tprol_) then 
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'

amgprec/impl/level/amg_s_base_onelev_free.f90

@@ -63,7 +63,7 @@ subroutine amg_s_base_onelev_free(lv,info)
   call lv%ac%free()
   if (lv%desc_ac%is_ok()) &
        & call lv%desc_ac%free(info)
-  call lv%map%free(info)
+  call lv%linmap%free(info)
 
   ! This is a pointer to something else, must not free it here. 
   nullify(lv%base_a) 

amgprec/impl/level/amg_s_base_onelev_map_prol.F90

@@ -0,0 +1,135 @@
+!  
+!   
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2020 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
+  use psb_base_mod
+  use amg_s_onelev_mod, amg_protect_name =>  amg_s_base_onelev_map_prol_v
+  
+  implicit none
+  class(amg_s_onelev_type), target, intent(inout) :: lv
+  real(psb_spk_), intent(in)           :: alpha, beta
+  type(psb_s_vect_type), intent(inout) :: vect_u, vect_v
+  integer(psb_ipk_), intent(out)       :: info
+  real(psb_spk_), optional          :: work(:)
+  type(psb_s_vect_type), optional, target, intent(inout)  :: vtx,vty
+  
+!!$  write(0,*) 'New map_prol',lv%remap_data%ac_pre_remap%is_asb()
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+!!$    write(0,*) 'Remap handling '
+    block
+      type(psb_ctxt_type) :: ctxt, nctxt
+      integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
+      integer(psb_ipk_) :: me, np,  rme, rnp
+      real(psb_spk_), allocatable :: rsnd(:), rrcv(:)
+      type(psb_s_vect_type) :: tv
+
+      ctxt = lv%remap_data%desc_ac_pre_remap%get_ctxt()
+      call psb_info(ctxt,me,np)
+!!$      write(0,*) 'Old context ',me,np,psb_errstatus_fatal()
+      nctxt = lv%desc_ac%get_ctxt()
+      call psb_info(nctxt,rme,rnp)
+!!$      write(0,*) 'New context ',rme,rnp,psb_errstatus_fatal()
+      idest = lv%remap_data%idest
+      associate(isrc => lv%remap_data%isrc, nrsrc => lv%remap_data%nrsrc)
+!!$        write(0,*) 'Should apply maps, then receive data from ',idest,' to ',me,psb_errstatus_fatal()
+        nsrc = size(isrc)
+        nrl  = lv%remap_data%desc_ac_pre_remap%get_local_rows()
+        nrc  = lv%remap_data%desc_ac_pre_remap%get_local_cols()
+        if (rme >=0) then
+          allocate(rrcv(sum(nrsrc)))
+          rrcv   = vect_v%get_vect()
+!!$          write(0,*) me,rme,' Size check ',size(rrcv),lv%desc_ac%get_local_rows(),psb_errstatus_fatal()
+          kp = 0
+          do i = 1,size(isrc)
+            ip = isrc(i)
+            nrl = nrsrc(i)
+!!$            write(0,*) me,' Sending to ',ip,nrl,kp+1,kp+nrl
+            call psb_snd(ctxt,rrcv(kp+1:kp+nrl),ip)
+            kp = kp + nrl
+          end do
+        end if
+        nrl = lv%remap_data%desc_ac_pre_remap%get_local_rows()
+        call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info)
+!!$        write(0,*) me, ' Allocated ',nrl,info,psb_errstatus_fatal()
+        
+        call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) 
+!!$        write(0,*) me,' Size of TV ',nrl,tv%get_nrows(),info
+!!$        write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal()
+        call psb_realloc(nrc,rsnd,info)
+        call psb_rcv(ctxt,rsnd(1:nrl),idest)
+        call tv%set_vect(rsnd)
+        call lv%linmap%map_V2U(alpha,tv,beta,vect_u,info,&
+             & work=work,vtx=vtx,vty=vty)
+      end associate
+!!$      write(0,*) me, ' Prolongator with remap done '
+!!$      flush(0)
+!!$      call psb_barrier(ctxt)
+    end block
+  else
+    ! Default transfer
+    call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,&
+         & work=work,vtx=vtx,vty=vty)
+  end if
+  
+end subroutine amg_s_base_onelev_map_prol_v
+
+subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
+  use psb_base_mod
+  use amg_s_onelev_mod, amg_protect_name =>  amg_s_base_onelev_map_prol_a
+  implicit none
+  class(amg_s_onelev_type), target, intent(inout) :: lv
+  real(psb_spk_), intent(in)     :: alpha, beta
+  real(psb_spk_), intent(inout)   :: u(:)
+  real(psb_spk_), intent(out)     :: v(:)
+  integer(psb_ipk_), intent(out) :: info
+  real(psb_spk_), optional          :: work(:)
+
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+    write(0,*) 'Remap handling not implemented yet '
+  else
+    ! Default transfer
+    call lv%linmap%map_V2U(alpha,v,beta,u,info,&
+         & work=work)
+  end if
+  
+end subroutine amg_s_base_onelev_map_prol_a

amgprec/impl/level/amg_s_base_onelev_map_rstr.F90

@@ -0,0 +1,129 @@
+!  
+!   
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2020 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+
+subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
+     &  work,vtx,vty)
+  use psb_base_mod
+  use amg_s_onelev_mod, amg_protect_name =>  amg_s_base_onelev_map_rstr_v
+  implicit none
+  class(amg_s_onelev_type), target, intent(inout) :: lv
+  real(psb_spk_), intent(in)           :: alpha, beta
+  type(psb_s_vect_type), intent(inout) :: vect_u, vect_v
+  integer(psb_ipk_), intent(out)       :: info
+  real(psb_spk_), optional          :: work(:)
+  type(psb_s_vect_type), optional, target, intent(inout)  :: vtx,vty
+
+!!$  write(0,*) 'New map_rstr',lv%remap_data%ac_pre_remap%is_asb()
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+!!$    write(0,*) 'Remap handling not implemented yet '
+    block
+      type(psb_ctxt_type) :: ctxt, nctxt
+      integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp
+      integer(psb_ipk_) :: me, np,  rme, rnp
+      real(psb_spk_), allocatable :: rsnd(:), rrcv(:)
+      type(psb_s_vect_type) :: tv
+      
+      ctxt = lv%remap_data%desc_ac_pre_remap%get_ctxt()
+      call psb_info(ctxt,me,np)
+      nctxt = lv%desc_ac%get_ctxt()
+      call psb_info(nctxt,rme,rnp)
+!!$      write(0,*) 'New context ',rme,rnp
+      idest = lv%remap_data%idest
+      associate(isrc => lv%remap_data%isrc, nrsrc => lv%remap_data%nrsrc)
+!!$        write(0,*) 'Should apply maps, then send data from ',me,' to ',idest
+!!$        if (rme >= 0) write(0,*) rme, '  Receiving      data from ',isrc(:)
+        nsrc = size(isrc)
+        nrl  = lv%remap_data%desc_ac_pre_remap%get_local_rows()
+        call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info)
+        call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) 
+!!$        write(0,*) me,' Size of TV ',tv%get_nrows()
+        call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,&
+             & work=work,vtx=vtx,vty=vty)
+        rsnd = tv%get_vect()
+        call psb_snd(ctxt,rsnd(1:nrl),idest)
+        if (rme >=0) then
+          allocate(rrcv(sum(nrsrc)))
+!!$          write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows()
+          kp = 0
+          do i = 1,size(isrc)
+            ip = isrc(i)
+            nrl = nrsrc(i)
+!!$            write(0,*) me,' Receiving from ',ip,nrl,kp+1,kp+nrl,size(rrcv)
+            call psb_rcv(ctxt,rrcv(kp+1:kp+nrl),ip)
+            kp = kp + nrl
+          end do
+          call vect_v%set_vect(rrcv)
+        end if
+      end associate
+!!$      write(0,*) me, ' Restrictor with remap done '
+    end block
+ 
+  else
+    ! Default transfer
+    call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,&
+         & work=work,vtx=vtx,vty=vty)
+  end if
+  
+end subroutine amg_s_base_onelev_map_rstr_v
+
+subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
+  use psb_base_mod
+  use amg_s_onelev_mod, amg_protect_name =>  amg_s_base_onelev_map_rstr_a
+  implicit none
+  class(amg_s_onelev_type), target, intent(inout) :: lv
+  real(psb_spk_), intent(in)     :: alpha, beta
+  real(psb_spk_), intent(inout)   :: u(:)
+  real(psb_spk_), intent(out)     :: v(:)
+  integer(psb_ipk_), intent(out) :: info
+  real(psb_spk_), optional       :: work(:)
+
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+    write(0,*) 'Remap handling not implemented yet '
+  else
+    ! Default transfer
+    call lv%linmap%map_U2V(alpha,u,beta,v,info,&
+         & work=work)
+  end if
+  
+end subroutine amg_s_base_onelev_map_rstr_a

amgprec/impl/level/amg_s_base_onelev_mat_asb.f90

@@ -53,7 +53,7 @@
 !  2. Call amg_Xaggrmat_asb to compute prolongator/restrictor/AC
 !  3. According to the choice of DIST/REPL for AC, build a descriptor DESC_AC,
 !     and adjust the column numbering of AC/OP_PROL/OP_RESTR
-!  4. Pack restrictor and prolongator into p%map
+!  4. Pack restrictor and prolongator into p%linmap
 !  5. Fix base_a and base_desc pointers.
 !
 ! 
@@ -158,7 +158,7 @@ subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
   
   if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,&
-       & ilaggr,nlaggr,op_restr,op_prol,lv%map,info)
+       & ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info)
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld')
     goto 9999

amgprec/impl/level/amg_z_base_onelev_build.f90

@@ -71,72 +71,81 @@ subroutine amg_z_base_onelev_build(lv,info,amold,vmold,imold,ilv)
   ctxt = lv%base_desc%get_ctxt()
   call psb_info(ctxt,me,np)
 
-  if (.not.allocated(lv%sm)) then 
-    !! Error: should have called amg_dprecinit
-    info=3111
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-  if (.not.allocated(lv%sm%sv)) then 
-    !! Error: should have called amg_dprecinit
-    info=3111
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-  lv%ac_nz_loc = lv%ac%get_nzeros()
-  lv%ac_nz_tot = lv%ac_nz_loc
-  select case(lv%parms%coarse_mat)
-  case(amg_distr_mat_) 
-    call psb_sum(ctxt,lv%ac_nz_tot)
-  case(amg_repl_mat_)
-    ! Do nothing
-  case default
-    ! Should never get here
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='Wrong lv%parms')
-    goto 9999
-  end select
-  
-  
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Calling mlprcbld at level  ',i
-  call amg_check_def(lv%parms%sweeps_pre,&
-       & 'Jacobi sweeps',izero,is_int_non_negative)
-  call amg_check_def(lv%parms%sweeps_post,&
-       & 'Jacobi sweeps',izero,is_int_non_negative)
-
-  call lv%sm%build(lv%base_a,lv%base_desc,info)
-  if (info == 0) then
-    if (allocated(lv%sm2a)) then 
-      call lv%sm2a%build(lv%base_a,lv%base_desc,info)
-      lv%sm2 => lv%sm2a
-    else
-      lv%sm2 => lv%sm
+  !
+  ! At top level(s) I may be using
+  ! a context with less processes
+  !
+  if (me < 0) then
+!!$    write(0,*) 'onelevbld: I am excluded from this one '
+  else
+!!$    write(0,*) me,' Going to build smoothers at this level '
+    if (.not.allocated(lv%sm)) then 
+      !! Error: should have called amg_dprecinit
+      info=3111
+      call psb_errpush(info,name)
+      goto 9999
     end if
-  end if
-  if (info /=0 ) then
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,&
-         & a_err='Smoother bld error')
-    goto 9999
-  end if
-
-  if (lv%sm%sv%is_global()) then
-    if ((lv%parms%sweeps_pre>1).or.(lv%parms%sweeps_post>1)) then
-      lv%parms%sweeps_pre  = 1
-      lv%parms%sweeps_post = 1
-      if (me == 0) then
-        write(debug_unit,*) 
-        if (present(ilv)) then
-          write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
-               & '" at level ',ilv
-          write(debug_unit,*) '         is configured as a global solver '
-        else
-          write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
-               & '" is configured as a global solver '
+    if (.not.allocated(lv%sm%sv)) then 
+      !! Error: should have called amg_dprecinit
+      info=3111
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+    lv%ac_nz_loc = lv%ac%get_nzeros()
+    lv%ac_nz_tot = lv%ac_nz_loc
+    select case(lv%parms%coarse_mat)
+    case(amg_distr_mat_) 
+      call psb_sum(ctxt,lv%ac_nz_tot)
+    case(amg_repl_mat_)
+      ! Do nothing
+    case default
+      ! Should never get here
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,a_err='Wrong lv%parms')
+      goto 9999
+    end select
+    
+    
+    if (debug_level >= psb_debug_outer_) &
+         & write(debug_unit,*) me,' ',trim(name),&
+         & 'Calling mlprcbld at level  ',i
+    call amg_check_def(lv%parms%sweeps_pre,&
+         & 'Jacobi sweeps',izero,is_int_non_negative)
+    call amg_check_def(lv%parms%sweeps_post,&
+         & 'Jacobi sweeps',izero,is_int_non_negative)
+    
+    call lv%sm%build(lv%base_a,lv%base_desc,info)
+    if (info == 0) then
+      if (allocated(lv%sm2a)) then 
+        call lv%sm2a%build(lv%base_a,lv%base_desc,info)
+        lv%sm2 => lv%sm2a
+      else
+        lv%sm2 => lv%sm
+      end if
+    end if
+    if (info /=0 ) then
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,&
+           & a_err='Smoother bld error')
+      goto 9999
+    end if
+    
+    if (lv%sm%sv%is_global()) then
+      if ((lv%parms%sweeps_pre>1).or.(lv%parms%sweeps_post>1)) then
+        lv%parms%sweeps_pre  = 1
+        lv%parms%sweeps_post = 1
+        if (me == 0) then
+          write(debug_unit,*) 
+          if (present(ilv)) then
+            write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
+                 & '" at level ',ilv
+            write(debug_unit,*) '         is configured as a global solver '
+          else
+            write(debug_unit,*) 'Warning: the solver "',trim(lv%sm%sv%get_fmt()),&
+                 & '" is configured as a global solver '
+          end if
+          write(debug_unit,*) '        Pre and post sweeps at this level reset to 1'
         end if
-        write(debug_unit,*) '        Pre and post sweeps at this level reset to 1'
       end if
     end if
   end if

amgprec/impl/level/amg_z_base_onelev_cnv.f90

@@ -62,6 +62,6 @@ subroutine amg_z_base_onelev_cnv(lv,info,amold,vmold,imold)
          & call lv%ac%cscnv(info,mold=amold)
     if (info == psb_success_ .and. lv%desc_ac%is_ok() &
          & .and. present(imold)) call lv%desc_ac%cnv(imold)
-    if (info == psb_success_) call lv%map%cnv(info,mold=amold,imold=imold)
+    if (info == psb_success_) call lv%linmap%cnv(info,mold=amold,imold=imold)
   end if
 end subroutine amg_z_base_onelev_cnv

amgprec/impl/level/amg_z_base_onelev_csetc.F90

@@ -1,15 +1,15 @@
-!  
-!   
+!
+!
 !                             AMG4PSBLAS version 1.0
 !    Algebraic Multigrid Package
 !               based on PSBLAS (Parallel Sparse BLAS version 3.5)
-!    
-!    (C) Copyright 2020 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
+!
+!    (C) Copyright 2020
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
 !    Redistribution and use in source and binary forms, with or without
 !    modification, are permitted provided that the following conditions
 !    are met:
@@ -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,10 +33,10 @@
 !    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.
-!   
-!  
+!
+!
 subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
-  
+
   use psb_base_mod
   use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_csetc
   use amg_z_base_aggregator_mod
@@ -49,6 +49,9 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
   use amg_z_ilu_solver
   use amg_z_id_solver
   use amg_z_gs_solver
+  use amg_z_ainv_solver
+  use amg_z_invk_solver
+  use amg_z_invt_solver
 #if defined(HAVE_UMF_)
   use amg_z_umf_solver
 #endif
@@ -65,16 +68,16 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
   Implicit None
 
   ! Arguments
-  class(amg_z_onelev_type), intent(inout) :: lv 
-  character(len=*), intent(in)              :: what 
+  class(amg_z_onelev_type), intent(inout) :: lv
+  character(len=*), intent(in)              :: what
   character(len=*), intent(in)              :: val
   integer(psb_ipk_), intent(out)            :: info
   character(len=*), optional, intent(in)    :: pos
   integer(psb_ipk_), intent(in), optional   :: idx
-  ! Local 
+  ! Local
   integer(psb_ipk_)  :: ipos_, err_act
   character(len=20) :: name='z_base_onelev_csetc'
-  integer(psb_ipk_) :: ival 
+  integer(psb_ipk_) :: ival
   type(amg_z_base_smoother_type)   :: amg_z_base_smoother_mold
   type(amg_z_jac_smoother_type)    ::  amg_z_jac_smoother_mold
   type(amg_z_l1_jac_smoother_type) ::  amg_z_l1_jac_smoother_mold
@@ -85,6 +88,9 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
   type(amg_z_id_solver_type)       ::  amg_z_id_solver_mold
   type(amg_z_gs_solver_type)       ::  amg_z_gs_solver_mold
   type(amg_z_bwgs_solver_type)     ::  amg_z_bwgs_solver_mold
+  type(amg_z_ainv_solver_type)     ::  amg_z_ainv_solver_mold
+  type(amg_z_invk_solver_type)     ::  amg_z_invk_solver_mold
+  type(amg_z_invt_solver_type)     ::  amg_z_invt_solver_mold
 #if defined(HAVE_UMF_)
   type(amg_z_umf_solver_type)     ::  amg_z_umf_solver_mold
 #endif
@@ -97,7 +103,7 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
 #if defined(HAVE_MUMPS_)
   type(amg_z_mumps_solver_type) ::  amg_z_mumps_solver_mold
 #endif
-  
+
 
   call psb_erractionsave(err_act)
 
@@ -118,14 +124,14 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
   else
     ipos_ = amg_smooth_both_
   end if
-  
+
   select case (psb_toupper(trim(what)))
   case ('SMOOTHER_TYPE')
     select case (psb_toupper(trim(val)))
     case ('NOPREC','NONE')
       call lv%set(amg_z_base_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_z_id_solver_mold,info,pos=pos)
-      
+
     case ('JAC','JACOBI')
       call lv%set(amg_z_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_z_diag_solver_mold,info,pos=pos)
@@ -133,11 +139,11 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
     case ('L1-JACOBI')
       call lv%set(amg_z_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_z_l1_diag_solver_mold,info,pos=pos)
-      
+
     case ('BJAC')
       call lv%set(amg_z_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_z_ilu_solver_mold,info,pos=pos)
-      
+
     case ('L1-BJAC')
       call lv%set(amg_z_l1_jac_smoother_mold,info,pos=pos)
       if (info == 0) call lv%set(amg_z_ilu_solver_mold,info,pos=pos)
@@ -166,59 +172,65 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
     case ('L1-BWGS')
       call lv%set(amg_z_l1_jac_smoother_mold,info,pos='pre')
       if (info == 0) call lv%set(amg_z_bwgs_solver_mold,info,pos='pre')
-      if (allocated(lv%sm2a)) deallocate(lv%sm2a)      
+      if (allocated(lv%sm2a)) deallocate(lv%sm2a)
     case ('L1-FBGS')
       call lv%set(amg_z_l1_jac_smoother_mold,info,pos='pre')
       if (info == 0) call lv%set(amg_z_gs_solver_mold,info,pos='pre')
       call lv%set(amg_z_l1_jac_smoother_mold,info,pos='post')
       if (info == 0) call lv%set(amg_z_bwgs_solver_mold,info,pos='post')
-      
+
     case default
       !
-      ! Do nothing and hope for the best :) 
+      ! Do nothing and hope for the best :)
       !
     end select
-    if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then 
+    if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
       if (allocated(lv%sm)) call lv%sm%default()
     end if
     if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then
       if (allocated(lv%sm2a)) call lv%sm2a%default()
     end if
-    
+
 
   case('SUB_SOLVE')
     select case (psb_toupper(trim(val)))
     case ('NONE','NOPREC','FACT_NONE')
       call lv%set(amg_z_id_solver_mold,info,pos=pos)
-      
+
     case ('DIAG')
       call lv%set(amg_z_diag_solver_mold,info,pos=pos)
-      
+
     case ('L1-DIAG')
       call lv%set(amg_z_l1_diag_solver_mold,info,pos=pos)
-      
+
     case ('GS','FGS','FWGS')
       call lv%set(amg_z_gs_solver_mold,info,pos=pos)
-      
+
     case ('BGS','BWGS')
       call lv%set(amg_z_bwgs_solver_mold,info,pos=pos)
-      
+
+    case ('AINV')
+      call lv%set(amg_z_ainv_solver_mold,info,pos=pos)
+    case ('INVK')
+      call lv%set(amg_z_invk_solver_mold,info,pos=pos)
+    case ('INVT')
+      call lv%set(amg_z_invt_solver_mold,info,pos=pos)
     case ('ILU','ILUT','MILU')
       call lv%set(amg_z_ilu_solver_mold,info,pos=pos)
       if (info == 0) then
-        if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then 
+        if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
           call lv%sm%sv%set('SUB_SOLVE',val,info)
         end if
-        if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then 
+        if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
           if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
         end if
       end if
 #ifdef HAVE_SLU_
-    case ('SLU') 
+    case ('SLU')
       call lv%set(amg_z_slu_solver_mold,info,pos=pos)
 #endif
 #ifdef HAVE_MUMPS_
-    case ('MUMPS') 
+    case ('MUMPS')
       call lv%set(amg_z_mumps_solver_mold,info,pos=pos)
 #endif
 #ifdef HAVE_SLUDIST_
@@ -231,10 +243,10 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
 #endif
     case default
       !
-      ! Do nothing and hope for the best :) 
+      ! Do nothing and hope for the best :)
       !
     end select
-    
+
   case ('ML_CYCLE')
     lv%parms%ml_cycle      = amg_stringval(val)
 
@@ -249,7 +261,7 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
         return
       end if
     end if
-    
+
     select case(ival)
     case(amg_dec_aggr_)
       allocate(amg_z_dec_aggregator_type :: lv%aggr, stat=info)
@@ -259,7 +271,7 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
       info =  psb_err_internal_error_
     end select
     if (info == psb_success_) call lv%aggr%default()
-    
+
   case ('AGGR_ORD')
     lv%parms%aggr_ord      = amg_stringval(val)
 
@@ -286,13 +298,13 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
     lv%parms%coarse_solve    = amg_stringval(val)
 
   case default
-    if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then 
-      if (allocated(lv%sm)) then 
+    if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
+      if (allocated(lv%sm)) then
         call lv%sm%set(what,val,info,idx=idx)
       end if
     end if
-    if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then 
-      if (allocated(lv%sm2a)) then 
+    if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
+      if (allocated(lv%sm2a)) then
         call lv%sm2a%set(what,val,info,idx=idx)
       end if
     end if

amgprec/impl/level/amg_z_base_onelev_descr.f90

@@ -35,21 +35,30 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !   
 !  
-subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout)
+!
+!
+! verbosity:
+!        <0: suppress all messages
+!         0: normal
+!        >1: increased details 
+!
+subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity)
   
   use psb_base_mod
   use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_descr
   Implicit None
   ! Arguments
-  class(amg_z_onelev_type), intent(in)  :: lv
+  class(amg_z_onelev_type), intent(in)    :: lv
   integer(psb_ipk_), intent(in)           :: il,nl,ilmin
   integer(psb_ipk_), intent(out)          :: info
   integer(psb_ipk_), intent(in), optional :: iout
+  integer(psb_ipk_), intent(in), optional :: verbosity
+
 
   ! Local variables
-  integer(psb_ipk_)      :: err_act
+  integer(psb_ipk_)  :: err_act
   character(len=20), parameter :: name='amg_z_base_onelev_descr'
-  integer(psb_ipk_)      :: iout_
+  integer(psb_ipk_)  :: iout_, verbosity_
   logical      :: coarse
 
 
@@ -63,6 +72,13 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout)
   else 
     iout_ = psb_out_unit
   end if
+  
+  if (present(verbosity)) then
+    verbosity_ = verbosity
+  else
+    verbosity_ = 0
+  end if
+  if (verbosity_ < 0) goto 9998
 
   write(iout_,*) 
   if (il == ilmin) then 
@@ -89,12 +105,22 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout)
     call lv%parms%descr(iout_,info,coarse=coarse)
 
     if (nl > 1) then 
-      if (allocated(lv%map%naggr)) then
+      if (allocated(lv%linmap%naggr)) then
         write(iout_,*) '  Coarse Matrix: Global size: ', &
-             &  sum((1_psb_lpk_*lv%map%naggr(:))),' Nonzeros: ',lv%ac_nz_tot
-        write(iout_,*) '          Local matrix sizes: ', &
-             &  lv%map%naggr(:)
-        write(iout_,*) '  Aggregation   ratio: ', &
+             &  lv%linmap%nagtot
+        write(iout_,*) '                    Nonzeros: ',lv%ac_nz_tot
+        if (verbosity_>0) then
+          write(iout_,*) '          Local matrix sizes: ', &
+               &  lv%linmap%naggr(:)
+        else 
+          write(iout_,'(2(a,1x,i12))') &
+               & '     Local  matrix sizes: min:', &
+               & lv%linmap%nagmin,'         max:', lv%linmap%nagmax
+          write(iout_,'(a,1x,f14.1)') &
+               & '                          avg:', &
+               & lv%linmap%nagavg
+        end if
+        write(iout_,'(a,1x,f14.2)') '          Aggregation   ratio: ', &
              &  lv%szratio
       end if
     end if
@@ -102,7 +128,8 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout)
     if (coarse.and.allocated(lv%sm)) &
          & call lv%sm%descr(info,iout=iout_,coarse=coarse)
   end if
-  
+
+9998 continue
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/level/amg_z_base_onelev_dump.f90

@@ -108,17 +108,17 @@ subroutine amg_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
         call lv%ac%print(fname,head=head,iv=ivr)
       end if
       if (rp_) then 
-        ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
-        ivc = lv%map%p_desc_V%get_global_indices(owned=.false.)
+        ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
+        ivc = lv%linmap%p_desc_V%get_global_indices(owned=.false.)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
-        call lv%map%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
+        call lv%linmap%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
-        call lv%map%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
+        call lv%linmap%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
       end if
       if (tprol_) then
         ! Tentative prolongator is stored with column indices already
         ! in global numbering, so only IVR is needed. 
-        ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
+        ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'
         !
         !  This is not implemented yet.
@@ -133,9 +133,9 @@ subroutine amg_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
       end if
       if (rp_) then 
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
-        call lv%map%mat_U2V%print(fname,head=head)
+        call lv%linmap%mat_U2V%print(fname,head=head)
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
-        call lv%map%mat_V2U%print(fname,head=head)
+        call lv%linmap%mat_V2U%print(fname,head=head)
       end if
       if (tprol_) then 
         write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'

amgprec/impl/level/amg_z_base_onelev_free.f90

@@ -63,7 +63,7 @@ subroutine amg_z_base_onelev_free(lv,info)
   call lv%ac%free()
   if (lv%desc_ac%is_ok()) &
        & call lv%desc_ac%free(info)
-  call lv%map%free(info)
+  call lv%linmap%free(info)
 
   ! This is a pointer to something else, must not free it here. 
   nullify(lv%base_a) 

amgprec/impl/level/amg_z_base_onelev_map_prol.F90

@@ -0,0 +1,135 @@
+!  
+!   
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2020 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+subroutine amg_z_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
+  use psb_base_mod
+  use amg_z_onelev_mod, amg_protect_name =>  amg_z_base_onelev_map_prol_v
+  
+  implicit none
+  class(amg_z_onelev_type), target, intent(inout) :: lv
+  complex(psb_dpk_), intent(in)           :: alpha, beta
+  type(psb_z_vect_type), intent(inout) :: vect_u, vect_v
+  integer(psb_ipk_), intent(out)       :: info
+  complex(psb_dpk_), optional          :: work(:)
+  type(psb_z_vect_type), optional, target, intent(inout)  :: vtx,vty
+  
+!!$  write(0,*) 'New map_prol',lv%remap_data%ac_pre_remap%is_asb()
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+!!$    write(0,*) 'Remap handling '
+    block
+      type(psb_ctxt_type) :: ctxt, nctxt
+      integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
+      integer(psb_ipk_) :: me, np,  rme, rnp
+      complex(psb_dpk_), allocatable :: rsnd(:), rrcv(:)
+      type(psb_z_vect_type) :: tv
+
+      ctxt = lv%remap_data%desc_ac_pre_remap%get_ctxt()
+      call psb_info(ctxt,me,np)
+!!$      write(0,*) 'Old context ',me,np,psb_errstatus_fatal()
+      nctxt = lv%desc_ac%get_ctxt()
+      call psb_info(nctxt,rme,rnp)
+!!$      write(0,*) 'New context ',rme,rnp,psb_errstatus_fatal()
+      idest = lv%remap_data%idest
+      associate(isrc => lv%remap_data%isrc, nrsrc => lv%remap_data%nrsrc)
+!!$        write(0,*) 'Should apply maps, then receive data from ',idest,' to ',me,psb_errstatus_fatal()
+        nsrc = size(isrc)
+        nrl  = lv%remap_data%desc_ac_pre_remap%get_local_rows()
+        nrc  = lv%remap_data%desc_ac_pre_remap%get_local_cols()
+        if (rme >=0) then
+          allocate(rrcv(sum(nrsrc)))
+          rrcv   = vect_v%get_vect()
+!!$          write(0,*) me,rme,' Size check ',size(rrcv),lv%desc_ac%get_local_rows(),psb_errstatus_fatal()
+          kp = 0
+          do i = 1,size(isrc)
+            ip = isrc(i)
+            nrl = nrsrc(i)
+!!$            write(0,*) me,' Sending to ',ip,nrl,kp+1,kp+nrl
+            call psb_snd(ctxt,rrcv(kp+1:kp+nrl),ip)
+            kp = kp + nrl
+          end do
+        end if
+        nrl = lv%remap_data%desc_ac_pre_remap%get_local_rows()
+        call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info)
+!!$        write(0,*) me, ' Allocated ',nrl,info,psb_errstatus_fatal()
+        
+        call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) 
+!!$        write(0,*) me,' Size of TV ',nrl,tv%get_nrows(),info
+!!$        write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal()
+        call psb_realloc(nrc,rsnd,info)
+        call psb_rcv(ctxt,rsnd(1:nrl),idest)
+        call tv%set_vect(rsnd)
+        call lv%linmap%map_V2U(alpha,tv,beta,vect_u,info,&
+             & work=work,vtx=vtx,vty=vty)
+      end associate
+!!$      write(0,*) me, ' Prolongator with remap done '
+!!$      flush(0)
+!!$      call psb_barrier(ctxt)
+    end block
+  else
+    ! Default transfer
+    call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,&
+         & work=work,vtx=vtx,vty=vty)
+  end if
+  
+end subroutine amg_z_base_onelev_map_prol_v
+
+subroutine amg_z_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
+  use psb_base_mod
+  use amg_z_onelev_mod, amg_protect_name =>  amg_z_base_onelev_map_prol_a
+  implicit none
+  class(amg_z_onelev_type), target, intent(inout) :: lv
+  complex(psb_dpk_), intent(in)     :: alpha, beta
+  complex(psb_dpk_), intent(inout)   :: u(:)
+  complex(psb_dpk_), intent(out)     :: v(:)
+  integer(psb_ipk_), intent(out) :: info
+  complex(psb_dpk_), optional          :: work(:)
+
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+    write(0,*) 'Remap handling not implemented yet '
+  else
+    ! Default transfer
+    call lv%linmap%map_V2U(alpha,v,beta,u,info,&
+         & work=work)
+  end if
+  
+end subroutine amg_z_base_onelev_map_prol_a

amgprec/impl/level/amg_z_base_onelev_map_rstr.F90

@@ -0,0 +1,129 @@
+!  
+!   
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.5)
+!    
+!    (C) Copyright 2020 
+!  
+!        Salvatore Filippone  
+!        Pasqua D'Ambra   
+!        Fabio Durastante        
+!   
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!   
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!   
+!  
+
+subroutine amg_z_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
+     &  work,vtx,vty)
+  use psb_base_mod
+  use amg_z_onelev_mod, amg_protect_name =>  amg_z_base_onelev_map_rstr_v
+  implicit none
+  class(amg_z_onelev_type), target, intent(inout) :: lv
+  complex(psb_dpk_), intent(in)           :: alpha, beta
+  type(psb_z_vect_type), intent(inout) :: vect_u, vect_v
+  integer(psb_ipk_), intent(out)       :: info
+  complex(psb_dpk_), optional          :: work(:)
+  type(psb_z_vect_type), optional, target, intent(inout)  :: vtx,vty
+
+!!$  write(0,*) 'New map_rstr',lv%remap_data%ac_pre_remap%is_asb()
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+!!$    write(0,*) 'Remap handling not implemented yet '
+    block
+      type(psb_ctxt_type) :: ctxt, nctxt
+      integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp
+      integer(psb_ipk_) :: me, np,  rme, rnp
+      complex(psb_dpk_), allocatable :: rsnd(:), rrcv(:)
+      type(psb_z_vect_type) :: tv
+      
+      ctxt = lv%remap_data%desc_ac_pre_remap%get_ctxt()
+      call psb_info(ctxt,me,np)
+      nctxt = lv%desc_ac%get_ctxt()
+      call psb_info(nctxt,rme,rnp)
+!!$      write(0,*) 'New context ',rme,rnp
+      idest = lv%remap_data%idest
+      associate(isrc => lv%remap_data%isrc, nrsrc => lv%remap_data%nrsrc)
+!!$        write(0,*) 'Should apply maps, then send data from ',me,' to ',idest
+!!$        if (rme >= 0) write(0,*) rme, '  Receiving      data from ',isrc(:)
+        nsrc = size(isrc)
+        nrl  = lv%remap_data%desc_ac_pre_remap%get_local_rows()
+        call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info)
+        call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) 
+!!$        write(0,*) me,' Size of TV ',tv%get_nrows()
+        call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,&
+             & work=work,vtx=vtx,vty=vty)
+        rsnd = tv%get_vect()
+        call psb_snd(ctxt,rsnd(1:nrl),idest)
+        if (rme >=0) then
+          allocate(rrcv(sum(nrsrc)))
+!!$          write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows()
+          kp = 0
+          do i = 1,size(isrc)
+            ip = isrc(i)
+            nrl = nrsrc(i)
+!!$            write(0,*) me,' Receiving from ',ip,nrl,kp+1,kp+nrl,size(rrcv)
+            call psb_rcv(ctxt,rrcv(kp+1:kp+nrl),ip)
+            kp = kp + nrl
+          end do
+          call vect_v%set_vect(rrcv)
+        end if
+      end associate
+!!$      write(0,*) me, ' Restrictor with remap done '
+    end block
+ 
+  else
+    ! Default transfer
+    call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,&
+         & work=work,vtx=vtx,vty=vty)
+  end if
+  
+end subroutine amg_z_base_onelev_map_rstr_v
+
+subroutine amg_z_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
+  use psb_base_mod
+  use amg_z_onelev_mod, amg_protect_name =>  amg_z_base_onelev_map_rstr_a
+  implicit none
+  class(amg_z_onelev_type), target, intent(inout) :: lv
+  complex(psb_dpk_), intent(in)     :: alpha, beta
+  complex(psb_dpk_), intent(inout)   :: u(:)
+  complex(psb_dpk_), intent(out)     :: v(:)
+  integer(psb_ipk_), intent(out) :: info
+  complex(psb_dpk_), optional       :: work(:)
+
+  if (lv%remap_data%ac_pre_remap%is_asb()) then
+    !
+    ! Remap has happened, deal with it
+    !
+    write(0,*) 'Remap handling not implemented yet '
+  else
+    ! Default transfer
+    call lv%linmap%map_U2V(alpha,u,beta,v,info,&
+         & work=work)
+  end if
+  
+end subroutine amg_z_base_onelev_map_rstr_a

amgprec/impl/level/amg_z_base_onelev_mat_asb.f90

@@ -53,7 +53,7 @@
 !  2. Call amg_Xaggrmat_asb to compute prolongator/restrictor/AC
 !  3. According to the choice of DIST/REPL for AC, build a descriptor DESC_AC,
 !     and adjust the column numbering of AC/OP_PROL/OP_RESTR
-!  4. Pack restrictor and prolongator into p%map
+!  4. Pack restrictor and prolongator into p%linmap
 !  5. Fix base_a and base_desc pointers.
 !
 ! 
@@ -158,7 +158,7 @@ subroutine amg_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
   if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
   
   if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,&
-       & ilaggr,nlaggr,op_restr,op_prol,lv%map,info)
+       & ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info)
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld')
     goto 9999

amgprec/impl/solver/Makefile

@@ -198,9 +198,6 @@ amg_s_ainv_solver_csetc.o \
 amg_s_ainv_solver_cseti.o \
 amg_s_ainv_solver_csetr.o \
 amg_s_ainv_solver_descr.o \
-amg_s_ainv_solver_setc.o \
-amg_s_ainv_solver_seti.o \
-amg_s_ainv_solver_setr.o \
 amg_d_ainv_solver_bld.o \
 amg_d_ainv_solver_check.o \
 amg_d_ainv_solver_clone.o \
@@ -208,9 +205,6 @@ amg_d_ainv_solver_csetc.o \
 amg_d_ainv_solver_cseti.o \
 amg_d_ainv_solver_csetr.o \
 amg_d_ainv_solver_descr.o \
-amg_d_ainv_solver_setc.o \
-amg_d_ainv_solver_seti.o \
-amg_d_ainv_solver_setr.o \
 amg_c_ainv_solver_bld.o \
 amg_c_ainv_solver_check.o \
 amg_c_ainv_solver_clone.o \
@@ -218,9 +212,13 @@ amg_c_ainv_solver_csetc.o \
 amg_c_ainv_solver_cseti.o \
 amg_c_ainv_solver_csetr.o \
 amg_c_ainv_solver_descr.o \
-amg_c_ainv_solver_setc.o \
-amg_c_ainv_solver_seti.o \
-amg_c_ainv_solver_setr.o \
+amg_z_ainv_solver_bld.o \
+amg_z_ainv_solver_check.o \
+amg_z_ainv_solver_clone.o \
+amg_z_ainv_solver_csetc.o \
+amg_z_ainv_solver_cseti.o \
+amg_z_ainv_solver_csetr.o \
+amg_z_ainv_solver_descr.o \
 amg_s_base_ainv_solver_apply_vect.o \
 amg_s_base_ainv_solver_apply.o \
 amg_s_base_ainv_solver_cnv.o \
@@ -251,60 +249,44 @@ amg_d_invt_solver_clone.o \
 amg_d_invt_solver_cseti.o \
 amg_d_invt_solver_csetr.o \
 amg_d_invt_solver_descr.o \
-amg_d_invt_solver_seti.o \
-amg_d_invt_solver_setr.o \
 amg_d_invk_solver_bld.o \
 amg_d_invk_solver_check.o \
 amg_d_invk_solver_clone.o \
 amg_d_invk_solver_cseti.o \
 amg_d_invk_solver_descr.o \
-amg_d_invk_solver_seti.o \
 amg_s_invt_solver_bld.o \
 amg_s_invt_solver_check.o \
 amg_s_invt_solver_clone.o \
 amg_s_invt_solver_cseti.o \
 amg_s_invt_solver_csetr.o \
 amg_s_invt_solver_descr.o \
-amg_s_invt_solver_seti.o \
-amg_s_invt_solver_setr.o \
 amg_s_invk_solver_bld.o \
 amg_s_invk_solver_check.o \
 amg_s_invk_solver_clone.o \
 amg_s_invk_solver_cseti.o \
 amg_s_invk_solver_descr.o \
-amg_s_invk_solver_seti.o \
 amg_c_invt_solver_bld.o \
 amg_c_invt_solver_check.o \
 amg_c_invt_solver_clone.o \
 amg_c_invt_solver_cseti.o \
 amg_c_invt_solver_csetr.o \
 amg_c_invt_solver_descr.o \
-amg_c_invt_solver_seti.o \
-amg_c_invt_solver_setr.o \
 amg_c_invk_solver_bld.o \
 amg_c_invk_solver_check.o \
 amg_c_invk_solver_clone.o \
 amg_c_invk_solver_cseti.o \
 amg_c_invk_solver_descr.o \
-amg_c_invk_solver_seti.o \
 amg_z_invt_solver_bld.o \
 amg_z_invt_solver_check.o \
 amg_z_invt_solver_clone.o \
 amg_z_invt_solver_cseti.o \
 amg_z_invt_solver_csetr.o \
 amg_z_invt_solver_descr.o \
-amg_z_invt_solver_seti.o \
-amg_z_invt_solver_setr.o \
 amg_z_invk_solver_bld.o \
 amg_z_invk_solver_check.o \
 amg_z_invk_solver_clone.o \
 amg_z_invk_solver_cseti.o \
-amg_z_invk_solver_descr.o \
-amg_z_invk_solver_seti.o \
-amg_d_rkr_solver_impl.o \
-amg_s_rkr_solver_impl.o \
-amg_c_rkr_solver_impl.o \
-amg_z_rkr_solver_impl.o
+amg_z_invk_solver_descr.o 
 
 LIBNAME=libamg_prec.a
 

amgprec/impl/solver/amg_c_ainv_solver_descr.f90

@@ -48,7 +48,6 @@ subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse)
 
   ! Local variables
   integer(psb_ipk_)      :: err_act
-  integer(psb_ipk_)      :: ictxt, me, np
   character(len=20), parameter :: name='amg_c_ainv_solver_descr'
   integer(psb_ipk_)      :: iout_
 

amgprec/impl/solver/amg_c_invk_solver_descr.f90

@@ -48,8 +48,6 @@ subroutine amg_c_invk_solver_descr(sv,info,iout,coarse)
 
   ! Local variables
   integer(psb_ipk_)  :: err_act
-  integer(psb_ipk_)  :: me, np
-  type(psb_ctxt_type) :: ctxt
   character(len=20), parameter :: name='amg_c_invk_solver_descr'
   integer(psb_ipk_) :: iout_
 

amgprec/impl/solver/amg_c_invt_solver_descr.f90

@@ -48,7 +48,6 @@ subroutine amg_c_invt_solver_descr(sv,info,iout,coarse)
 
   ! Local variables
   integer(psb_ipk_) :: err_act
-  integer(psb_ipk_) :: ictxt, me, np
   character(len=20), parameter :: name='amg_c_invt_solver_descr'
   integer(psb_ipk_) :: iout_
 

amgprec/impl/solver/amg_d_ainv_solver_descr.f90

@@ -48,7 +48,6 @@ subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse)
 
   ! Local variables
   integer(psb_ipk_)      :: err_act
-  integer(psb_ipk_)      :: ictxt, me, np
   character(len=20), parameter :: name='amg_d_ainv_solver_descr'
   integer(psb_ipk_)      :: iout_
 

amgprec/impl/solver/amg_d_invk_solver_descr.f90

@@ -48,8 +48,6 @@ subroutine amg_d_invk_solver_descr(sv,info,iout,coarse)
 
   ! Local variables
   integer(psb_ipk_)  :: err_act
-  integer(psb_ipk_)  :: me, np
-  type(psb_ctxt_type) :: ctxt
   character(len=20), parameter :: name='amg_d_invk_solver_descr'
   integer(psb_ipk_) :: iout_
 

amgprec/impl/solver/amg_d_invt_solver_descr.f90

@@ -48,7 +48,6 @@ subroutine amg_d_invt_solver_descr(sv,info,iout,coarse)
 
   ! Local variables
   integer(psb_ipk_) :: err_act
-  integer(psb_ipk_) :: ictxt, me, np
   character(len=20), parameter :: name='amg_d_invt_solver_descr'
   integer(psb_ipk_) :: iout_
 

amgprec/impl/solver/amg_s_ainv_solver_descr.f90

@@ -48,7 +48,6 @@ subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse)
 
   ! Local variables
   integer(psb_ipk_)      :: err_act
-  integer(psb_ipk_)      :: ictxt, me, np
   character(len=20), parameter :: name='amg_s_ainv_solver_descr'
   integer(psb_ipk_)      :: iout_