Merge branch 'development' into ExperimentMixed

amgprec/amg_c_as_smoother.f90

@@ -120,7 +120,7 @@ module amg_c_as_smoother
   end interface
   
   interface 
-    subroutine amg_c_as_smoother_restr_v(sm,x,trans,info,data)
+    subroutine amg_c_as_smoother_restr_v(sm,x,trans,work,info,data)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
            & psb_spk_, amg_c_as_smoother_type, psb_epk_, &
            & psb_desc_type, psb_ipk_
@@ -128,6 +128,7 @@ module amg_c_as_smoother
       class(amg_c_as_smoother_type), intent(inout) :: sm
       type(psb_c_vect_type),intent(inout)          :: x
       character(len=1),intent(in)                    :: trans
+      complex(psb_spk_),target, intent(inout)          :: work(:)
       integer(psb_ipk_), intent(out)                 :: info
       integer(psb_ipk_), optional, intent(in)        :: data
     end subroutine amg_c_as_smoother_restr_v
@@ -149,7 +150,7 @@ module amg_c_as_smoother
   end interface
 
   interface 
-    subroutine amg_c_as_smoother_prol_v(sm,x,trans,info,data)
+    subroutine amg_c_as_smoother_prol_v(sm,x,trans,work,info,data)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
            & psb_spk_, amg_c_as_smoother_type, psb_epk_, &
            & psb_desc_type, psb_ipk_
@@ -157,6 +158,7 @@ module amg_c_as_smoother
       class(amg_c_as_smoother_type), intent(inout) :: sm
       type(psb_c_vect_type),intent(inout)          :: x
       character(len=1),intent(in)                    :: trans
+      complex(psb_spk_),target, intent(inout)          :: work(:)
       integer(psb_ipk_), intent(out)                 :: info
       integer(psb_ipk_), optional, intent(in)        :: data
     end subroutine amg_c_as_smoother_prol_v
@@ -180,7 +182,7 @@ module amg_c_as_smoother
   
   interface 
     subroutine amg_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
-      & trans,sweeps,wv,info,init,initu)
+      & trans,sweeps,work,wv,info,init,initu)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
            & psb_spk_, amg_c_as_smoother_type, psb_epk_, &
            & psb_desc_type, psb_ipk_
@@ -192,6 +194,7 @@ module amg_c_as_smoother
       complex(psb_spk_),intent(in)                     :: alpha,beta
       character(len=1),intent(in)                    :: trans
       integer(psb_ipk_), intent(in)                  :: sweeps
+      complex(psb_spk_),target, intent(inout)          :: work(:)
       type(psb_c_vect_type),intent(inout)          :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_c_base_aggregator_mod.f90

@@ -89,7 +89,7 @@ module amg_c_base_aggregator_mod
     procedure, pass(ag) :: bld_tprol   => amg_c_base_aggregator_build_tprol
     procedure, pass(ag) :: mat_bld     => amg_c_base_aggregator_mat_bld
     procedure, pass(ag) :: mat_asb     => amg_c_base_aggregator_mat_asb
-    procedure, pass(ag) :: bld_map     => amg_c_base_aggregator_bld_map
+    procedure, pass(ag) :: bld_linmap  => amg_c_base_aggregator_bld_linmap
     procedure, pass(ag) :: update_next => amg_c_base_aggregator_update_next
     procedure, pass(ag) :: clone       => amg_c_base_aggregator_clone
     procedure, pass(ag) :: free        => amg_c_base_aggregator_free
@@ -458,7 +458,7 @@ contains
   end subroutine amg_c_base_aggregator_mat_asb
 
   !
-  !> Function   bld_map
+  !> Function   bld_linmap
   !! \memberof  amg_c_base_aggregator_type
   !! \brief     Build linear map between hierarchy levels 
   !!
@@ -473,7 +473,7 @@ contains
   !!  \param map       The output map
   !!  \param info    Return code
   !!  
-  subroutine  amg_c_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
+  subroutine  amg_c_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
        & op_restr,op_prol,map,info)
     use psb_base_mod
     implicit none
@@ -484,7 +484,7 @@ contains
     type(psb_clinmap_type), intent(out)    :: map
     integer(psb_ipk_), intent(out)       :: info
     integer(psb_ipk_) :: err_act
-    character(len=20) :: name='c_base_aggregator_bld_map'
+    character(len=20) :: name='c_base_aggregator_bld_linmap'
 
     info = psb_success_
     call psb_erractionsave(err_act)
@@ -508,7 +508,6 @@ contains
 9999 call psb_error_handler(err_act)
 
     return
-  end subroutine amg_c_base_aggregator_bld_map
-
+  end subroutine amg_c_base_aggregator_bld_linmap
 
 end module amg_c_base_aggregator_mod

amgprec/amg_c_base_ainv_mod.f90

@@ -116,7 +116,7 @@ module amg_c_base_ainv_mod
 
   interface
     subroutine amg_c_base_ainv_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         &  trans,wv,info,init,initu)
+         &  trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_spk_,amg_c_base_ainv_solver_type, psb_c_vect_type, psb_ipk_
       type(psb_desc_type), intent(in)      :: desc_data
       class(amg_c_base_ainv_solver_type), intent(inout) :: sv
@@ -124,6 +124,7 @@ module amg_c_base_ainv_mod
       type(psb_c_vect_type),intent(inout)  :: y
       complex(psb_spk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)          :: trans
+      complex(psb_spk_),target, intent(inout) :: work(:)
       type(psb_c_vect_type),intent(inout)  :: wv(:)
       integer(psb_ipk_), intent(out)       :: info
       character, intent(in), optional      :: init

amgprec/amg_c_base_smoother_mod.f90

@@ -160,7 +160,7 @@ module amg_c_base_smoother_mod
   
   interface 
     subroutine amg_c_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
-         &  trans,sweeps,wv,info,init,initu)
+         &  trans,sweeps,work,wv,info,init,initu)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
            & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
            & amg_c_base_smoother_type, psb_ipk_
@@ -171,6 +171,7 @@ module amg_c_base_smoother_mod
       complex(psb_spk_),intent(in)                       :: alpha,beta
       character(len=1),intent(in)                      :: trans
       integer(psb_ipk_), intent(in)                    :: sweeps
+      complex(psb_spk_),target, intent(inout)            :: work(:)
       type(psb_c_vect_type),intent(inout)            :: wv(:)
       integer(psb_ipk_), intent(out)                   :: info
       character, intent(in), optional                :: init

amgprec/amg_c_base_solver_mod.f90

@@ -143,7 +143,7 @@ module amg_c_base_solver_mod
       
   interface 
     subroutine amg_c_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
            & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
            & amg_c_base_solver_type, psb_ipk_
@@ -154,6 +154,7 @@ module amg_c_base_solver_mod
       type(psb_c_vect_type),intent(inout)          :: y
       complex(psb_spk_),intent(in)                     :: alpha,beta
       character(len=1),intent(in)                    :: trans
+      complex(psb_spk_),target, intent(inout)          :: work(:)
       type(psb_c_vect_type),intent(inout)            :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_c_diag_solver.f90

@@ -77,7 +77,7 @@ module amg_c_diag_solver
 
   interface 
     subroutine amg_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& 
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
        & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
        & amg_c_diag_solver_type, psb_ipk_
@@ -87,6 +87,7 @@ module amg_c_diag_solver
       type(psb_c_vect_type), intent(inout)         :: y
       complex(psb_spk_),intent(in)                     :: alpha,beta
       character(len=1),intent(in)                    :: trans
+      complex(psb_spk_),target, intent(inout)          :: work(:)
       type(psb_c_vect_type),intent(inout)          :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_c_gs_solver.f90

@@ -106,7 +106,7 @@ module amg_c_gs_solver
 
   interface 
     subroutine amg_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_c_gs_solver_type, psb_c_vect_type, psb_spk_, &
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
       implicit none 
@@ -116,13 +116,14 @@ module amg_c_gs_solver
       type(psb_c_vect_type),intent(inout)         :: y
       complex(psb_spk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      complex(psb_spk_),target, intent(inout)         :: work(:)
       type(psb_c_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init
       type(psb_c_vect_type),intent(inout), optional   :: initu
     end subroutine amg_c_gs_solver_apply_vect
     subroutine amg_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_c_bwgs_solver_type, psb_c_vect_type, psb_spk_, &
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
       implicit none 
@@ -132,6 +133,7 @@ module amg_c_gs_solver
       type(psb_c_vect_type),intent(inout)         :: y
       complex(psb_spk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      complex(psb_spk_),target, intent(inout)         :: work(:)
       type(psb_c_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_c_id_solver.f90

@@ -64,7 +64,7 @@ module amg_c_id_solver
 
   interface 
     subroutine amg_c_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
            & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & 
            & amg_c_id_solver_type, psb_ipk_
@@ -74,6 +74,7 @@ module amg_c_id_solver
       type(psb_c_vect_type),intent(inout)        :: y
       complex(psb_spk_),intent(in)                   :: alpha,beta
       character(len=1),intent(in)                  :: trans
+      complex(psb_spk_),target, intent(inout)        :: work(:)
       type(psb_c_vect_type),intent(inout)        :: wv(:)
       integer(psb_ipk_), intent(out)               :: info
       character, intent(in), optional                :: init

amgprec/amg_c_ilu_solver.f90

@@ -101,7 +101,7 @@ module amg_c_ilu_solver
 
   interface 
     subroutine amg_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_c_ilu_solver_type, psb_c_vect_type, psb_spk_, &
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
       implicit none 
@@ -111,6 +111,7 @@ module amg_c_ilu_solver
       type(psb_c_vect_type),intent(inout)         :: y
       complex(psb_spk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      complex(psb_spk_),target, intent(inout)         :: work(:)
       type(psb_c_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_c_inner_mod.f90

@@ -67,7 +67,7 @@ module amg_c_inner_mod
   end interface amg_mlprec_bld
 
   interface amg_mlprec_aply
-    subroutine amg_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
+    subroutine amg_cmlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
       import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
       import :: amg_cprec_type
       implicit none 
@@ -79,18 +79,19 @@ module amg_c_inner_mod
       character,intent(in)               :: trans
       complex(psb_spk_),target             :: work(:)
       integer(psb_ipk_), intent(out)     :: info
-    end subroutine amg_cmlprec_aply
-    subroutine amg_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,info)
+    end subroutine amg_cmlprec_aply_a
+    subroutine amg_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
       import :: psb_cspmat_type, psb_desc_type, &
            & psb_spk_, psb_c_vect_type, psb_ipk_
       import :: amg_cprec_type
-      implicit none
+      implicit none 
       type(psb_desc_type),intent(in)        :: desc_data
       type(amg_cprec_type), intent(inout) :: p
       complex(psb_spk_),intent(in)            :: alpha,beta
       type(psb_c_vect_type),intent(inout) :: x
       type(psb_c_vect_type),intent(inout) :: y
       character,intent(in)                  :: trans
+      complex(psb_spk_),target                :: work(:)
       integer(psb_ipk_), intent(out)        :: info
     end subroutine amg_cmlprec_aply_vect
   end interface amg_mlprec_aply

amgprec/amg_c_jac_smoother.f90

@@ -106,7 +106,7 @@ module amg_c_jac_smoother
 
   interface
     subroutine amg_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
-         & sweeps,wv,info,init,initu)
+         & sweeps,work,wv,info,init,initu)
       import :: psb_desc_type, amg_c_jac_smoother_type, psb_c_vect_type, psb_spk_, &
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
            & psb_ipk_
@@ -118,6 +118,7 @@ module amg_c_jac_smoother
       complex(psb_spk_),intent(in)                      :: alpha,beta
       character(len=1),intent(in)                     :: trans
       integer(psb_ipk_), intent(in)                   :: sweeps
+      complex(psb_spk_),target, intent(inout)           :: work(:)
       type(psb_c_vect_type),intent(inout)           :: wv(:)
       integer(psb_ipk_), intent(out)                  :: info
       character, intent(in), optional                :: init

amgprec/amg_c_jac_solver.f90

@@ -101,7 +101,7 @@ module amg_c_jac_solver
 
   interface 
     subroutine amg_c_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
       implicit none 
@@ -111,6 +111,7 @@ module amg_c_jac_solver
       type(psb_c_vect_type),intent(inout)         :: y
       complex(psb_spk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      complex(psb_spk_),target, intent(inout)         :: work(:)
       type(psb_c_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_c_krm_solver.f90

@@ -131,7 +131,7 @@ module amg_c_krm_solver
 
   interface
     subroutine amg_c_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
       implicit none
@@ -141,6 +141,7 @@ module amg_c_krm_solver
       type(psb_c_vect_type),intent(inout)         :: y
       complex(psb_spk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      complex(psb_spk_),target, intent(inout)         :: work(:)
       type(psb_c_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_c_mumps_solver.F90

@@ -117,7 +117,7 @@ module amg_c_mumps_solver
 
   interface 
     subroutine c_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_c_mumps_solver_type, psb_c_vect_type, psb_dpk_, psb_spk_, &
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
       implicit none 
@@ -127,6 +127,7 @@ module amg_c_mumps_solver
       type(psb_c_vect_type),intent(inout)  :: y
       complex(psb_spk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)           :: trans
+      complex(psb_spk_),target, intent(inout) :: work(:)
       type(psb_c_vect_type),intent(inout) :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_c_onelev_mod.f90

@@ -154,13 +154,35 @@ module amg_c_onelev_mod
   private :: c_wrk_alloc, c_wrk_free, &
        & c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv, c_wrk_sizeof
 
+  !
+  ! Remap.
+  !  This keeps track of remapping.
+  !  Logic here is as follows:
+  !  1. AC_PRE_REMAP  need to figure out if we
+  !                really need it.
+  !  2. DESC_AC_PRE_REMAP  contains the descriptor before
+  !                remapping. Meaning that it is possible
+  !                to implement the RESTRICTOR operator by
+  !                 a. Doing LINMAP_U2V onto this one
+  !                 b. For each process, send the data to
+  !                    IDEST.
+  !                This assumes that remapping goes by
+  !                a factor of 2.
+  !                For the PROLONGATOR operators, we first
+  !                use DESC_AC, then split and send onto
+  !                the processes in DESC_AC_PRE_REMAP.
+  !
+  ! To be fixed: what happens if NP the starting processes
+  ! is not an even number? Coordinate with _X_remap in PSBLAS
+  ! 
   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
+    procedure, pass(rmp) :: clone      => c_remap_data_clone
+    procedure, pass(rmp) :: move_alloc => c_remap_move_alloc
   end type amg_c_remap_data_type
 
   type amg_c_onelev_type
@@ -206,7 +228,7 @@ module amg_c_onelev_mod
     procedure, pass(lv) :: get_wrksz => c_base_onelev_get_wrksize
     procedure, pass(lv) :: allocate_wrk   => c_base_onelev_allocate_wrk
     procedure, pass(lv) :: free_wrk       => c_base_onelev_free_wrk
-    procedure, nopass   :: stringval => amg_stringval
+    procedure, nopass   :: stringval  => amg_stringval
     procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc
 
 
@@ -230,9 +252,7 @@ module amg_c_onelev_mod
        & c_base_onelev_free_wrk
 
   interface
-    subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
-      import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lcspmat_type, psb_lpk_
-      import :: amg_c_onelev_type
+    module subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
       implicit none
       class(amg_c_onelev_type), intent(inout), target :: lv
       type(psb_cspmat_type), intent(in) :: a
@@ -244,10 +264,7 @@ module amg_c_onelev_mod
   end interface
 
   interface
-    subroutine amg_c_base_onelev_build(lv,info,amold,vmold,imold,ilv)
-      import :: psb_c_base_sparse_mat, psb_c_base_vect_type, &
-           & psb_i_base_vect_type, psb_spk_, amg_c_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_c_base_onelev_build(lv,info,amold,vmold,imold,ilv)
       implicit none
       class(amg_c_onelev_type), target, intent(inout) :: lv
       integer(psb_ipk_), intent(out) :: info
@@ -259,10 +276,7 @@ module amg_c_onelev_mod
   end interface
 
   interface
-    subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
-      import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
-           & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
       Implicit None
       ! Arguments
       class(amg_c_onelev_type), intent(in)    :: lv
@@ -275,10 +289,8 @@ module amg_c_onelev_mod
   end interface
 
   interface
-    subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
-      import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
-           & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,&
+         & iout,verbosity, prefix,global) 
       Implicit None
       ! Arguments
       class(amg_c_onelev_type), intent(in)    :: lv
@@ -292,10 +304,7 @@ module amg_c_onelev_mod
   end interface
 
   interface
-    subroutine amg_c_base_onelev_cnv(lv,info,amold,vmold,imold)
-      import :: amg_c_onelev_type, psb_c_base_vect_type, psb_spk_, &
-           & psb_c_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
-      ! Arguments
+    module subroutine amg_c_base_onelev_cnv(lv,info,amold,vmold,imold)
       class(amg_c_onelev_type), intent(inout)            :: lv
       integer(psb_ipk_), intent(out)                     :: info
       class(psb_c_base_sparse_mat), intent(in), optional :: amold
@@ -305,48 +314,32 @@ module amg_c_onelev_mod
   end interface
 
   interface
-    subroutine amg_c_base_onelev_free(lv,info)
-      import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
-           & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_c_base_onelev_free(lv,info)
       implicit none
-
       class(amg_c_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_c_base_onelev_free
   end interface
 
   interface
-    subroutine amg_c_base_onelev_free_smoothers(lv,info)
-      import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
-           & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_c_base_onelev_free_smoothers(lv,info)
       implicit none
-
       class(amg_c_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_c_base_onelev_free_smoothers
   end interface
 
   interface
-    subroutine amg_c_base_onelev_check(lv,info)
-      import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
-           & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_c_base_onelev_check(lv,info)
       Implicit None
-      ! Arguments
       class(amg_c_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)            :: info
     end subroutine amg_c_base_onelev_check
   end interface
 
   interface
-    subroutine amg_c_base_onelev_setsm(lv,val,info,pos)
-      import :: psb_spk_, amg_c_onelev_type, amg_c_base_smoother_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_c_base_onelev_setsm(lv,val,info,pos)
       Implicit None
-
-      ! Arguments
       class(amg_c_onelev_type), target, intent(inout) :: lv
       class(amg_c_base_smoother_type), intent(in)     :: val
       integer(psb_ipk_), intent(out)                  :: info
@@ -355,12 +348,8 @@ module amg_c_onelev_mod
   end interface
 
   interface
-    subroutine amg_c_base_onelev_setsv(lv,val,info,pos)
-      import :: psb_spk_, amg_c_onelev_type, amg_c_base_solver_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_c_base_onelev_setsv(lv,val,info,pos)
       Implicit None
-
-      ! Arguments
       class(amg_c_onelev_type), target, intent(inout) :: lv
       class(amg_c_base_solver_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
@@ -369,12 +358,8 @@ module amg_c_onelev_mod
   end interface
 
   interface
-    subroutine amg_c_base_onelev_setag(lv,val,info,pos)
-      import :: psb_spk_, amg_c_onelev_type, amg_c_base_aggregator_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_c_base_onelev_setag(lv,val,info,pos)
       Implicit None
-
-      ! Arguments
       class(amg_c_onelev_type), target, intent(inout) :: lv
       class(amg_c_base_aggregator_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
@@ -383,13 +368,8 @@ module amg_c_onelev_mod
   end interface
 
   interface
-    subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
-      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
+    module subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
       Implicit None
-
-      ! Arguments
       class(amg_c_onelev_type), intent(inout) :: lv
       character(len=*), intent(in)              :: what
       integer(psb_ipk_), intent(in)             :: val
@@ -400,12 +380,8 @@ module amg_c_onelev_mod
   end interface
 
   interface
-    subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
-      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
+    module 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
       character(len=*), intent(in)              :: val
@@ -416,12 +392,8 @@ module amg_c_onelev_mod
   end interface
 
   interface
-    subroutine amg_c_base_onelev_csetr(lv,what,val,info,pos,idx)
-      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
+    module subroutine amg_c_base_onelev_csetr(lv,what,val,info,pos,idx)
       Implicit None
-
       class(amg_c_onelev_type), intent(inout) :: lv
       character(len=*), intent(in)              :: what
       real(psb_spk_), intent(in)                 :: val
@@ -432,11 +404,8 @@ module amg_c_onelev_mod
   end interface
 
   interface
-    subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
+    module subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
          & solver,tprol,global_num)
-      import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
-           & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
       implicit none
       class(amg_c_onelev_type), intent(in) :: lv
       integer(psb_ipk_), intent(in)          :: level
@@ -447,8 +416,7 @@ module amg_c_onelev_mod
   end interface
 
   interface
-    subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
-      import
+    module subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
       implicit none
       class(amg_c_onelev_type), target, intent(inout) :: lv
       complex(psb_spk_), intent(in)     :: alpha, beta
@@ -457,20 +425,20 @@ module amg_c_onelev_mod
       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,vtx,vty)
-      import
+    module subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
+         & work,vtx,vty)
       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
+    module subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
       implicit none
       class(amg_c_onelev_type), target, intent(inout) :: lv
       complex(psb_spk_), intent(in)     :: alpha, beta
@@ -480,17 +448,130 @@ module amg_c_onelev_mod
       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,vtx,vty)
-      import
+    module subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,&
+         & work,vtx,vty)
       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
 
+  interface 
+    module subroutine c_base_onelev_move_alloc(lv, b,info)
+      implicit none
+      class(amg_c_onelev_type), target, intent(inout) :: lv, b
+      integer(psb_ipk_), intent(out) :: info
+    end subroutine c_base_onelev_move_alloc
+  end interface
+
+  interface 
+    module subroutine c_base_onelev_allocate_wrk(lv,info,vmold)
+      implicit none
+      class(amg_c_onelev_type), target, intent(inout) :: lv
+      integer(psb_ipk_), intent(out) :: info
+      class(psb_c_base_vect_type), intent(in), optional  :: vmold
+    end subroutine c_base_onelev_allocate_wrk
+  end interface
+  
+  interface 
+    module subroutine c_base_onelev_free_wrk(lv,info)
+      implicit none
+      class(amg_c_onelev_type), target, intent(inout) :: lv
+      integer(psb_ipk_), intent(out) :: info
+    end subroutine c_base_onelev_free_wrk
+  end interface
+
+  interface 
+    module  subroutine c_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
+      Implicit None
+      ! Arguments
+      class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(in)                     :: nwv
+      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
+    end subroutine c_wrk_alloc
+  end interface
+
+  interface 
+    module subroutine c_inner_do_wrk_alloc(wk,nwv,desc,vmold)
+      class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(in)                     :: nwv
+      type(psb_desc_type), intent(in)                   :: desc
+      class(psb_c_base_vect_type), intent(in), optional  :: vmold
+    end subroutine c_inner_do_wrk_alloc
+  end interface
+
+  interface 
+    module  subroutine c_wrk_free(wk,info)
+      Implicit None
+      ! Arguments
+      class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(out)                    :: info
+    end subroutine c_wrk_free
+  end interface
+
+  interface 
+    module  subroutine c_wrk_clone(wk,wkout,info)
+      Implicit None
+      ! Arguments
+      class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
+      class(amg_cmlprec_wrk_type), target, intent(inout) :: wkout
+      integer(psb_ipk_), intent(out)                    :: info
+    end subroutine c_wrk_clone
+  end interface
+
+  interface 
+    module subroutine c_wrk_move_alloc(wk, b,info)
+      implicit none
+      class(amg_cmlprec_wrk_type), target, intent(inout) :: wk, b
+      integer(psb_ipk_), intent(out) :: info
+    end subroutine c_wrk_move_alloc
+  end interface
+
+  interface
+    module subroutine c_wrk_cnv(wk,info,vmold)
+      Implicit None
+      class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(out)                    :: info
+      class(psb_c_base_vect_type), intent(in), optional  :: vmold
+    end subroutine c_wrk_cnv
+  end interface
+
+  interface
+    module function c_wrk_sizeof(wk) result(val)
+      implicit none
+      class(amg_cmlprec_wrk_type), intent(in) :: wk
+      integer(psb_epk_) :: val
+    end  function c_wrk_sizeof
+  end interface
+
+  interface 
+    module subroutine c_remap_data_clone(rmp, remap_out, info)
+      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
+    end subroutine c_remap_data_clone
+  end interface
+
+  interface 
+    module subroutine c_remap_move_alloc(rmp, remap_out, info)
+      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
+    end subroutine c_remap_move_alloc
+  end interface
+  
+
 contains
   !
   ! Function returning the size of the amg_prec_type data structure
@@ -616,7 +697,7 @@ contains
     ! Arguments
     class(amg_c_onelev_type), target, intent(inout) :: lv
     class(amg_c_onelev_type), target, intent(inout) :: lvout
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                  :: info
 
     info = psb_success_
     if (allocated(lv%sm)) then
@@ -658,36 +739,6 @@ contains
 
   end subroutine c_base_onelev_clone
 
-  subroutine c_base_onelev_move_alloc(lv, b,info)
-    use psb_base_mod
-    implicit none
-    class(amg_c_onelev_type), target, intent(inout) :: lv, b
-    integer(psb_ipk_), intent(out) :: info
-
-    call b%free(info)
-    b%parms  = lv%parms
-    b%szratio = lv%szratio
-    if (associated(lv%sm2,lv%sm2a)) then
-      call move_alloc(lv%sm,b%sm)
-      call move_alloc(lv%sm2a,b%sm2a)
-      b%sm2 =>b%sm2a
-    else
-      call move_alloc(lv%sm,b%sm)
-      call move_alloc(lv%sm2a,b%sm2a)
-      b%sm2 =>b%sm
-    end if
-
-    call move_alloc(lv%aggr,b%aggr)
-    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%linmap,b%linmap,info)
-    b%base_a    => lv%base_a
-    b%base_desc => lv%base_desc
-
-  end subroutine c_base_onelev_move_alloc
-
-
   function c_base_onelev_get_wrksize(lv) result(val)
     implicit none
     class(amg_c_onelev_type), intent(inout) :: lv
@@ -725,269 +776,5 @@ contains
 
   end function c_base_onelev_get_wrksize
 
-  subroutine c_base_onelev_allocate_wrk(lv,info,vmold)
-    use psb_base_mod
-    implicit none
-    class(amg_c_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
-    class(psb_c_base_vect_type), intent(in), optional  :: vmold
-    !
-    integer(psb_ipk_) :: nwv, i
-    info = psb_success_
-    nwv = lv%get_wrksz()
-    if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
-    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
-
-
-  subroutine c_base_onelev_free_wrk(lv,info)
-    use psb_base_mod
-    implicit none
-    class(amg_c_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
-    !
-    integer(psb_ipk_) :: nwv,i
-    info = psb_success_
-
-    if (allocated(lv%wrk)) then
-      call lv%wrk%free(info)
-      if (info == 0) deallocate(lv%wrk,stat=info)
-    end if
-  end subroutine c_base_onelev_free_wrk
-
-  subroutine c_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
-    use psb_base_mod
-
-    Implicit None
-
-    ! Arguments
-    class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(in)                     :: nwv
-    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)
-    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)
-      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)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
-    !
-    integer(psb_ipk_) :: i
-    info = psb_success_
-
-    if (allocated(wk%tx)) deallocate(wk%tx, stat=info)
-    if (allocated(wk%ty)) deallocate(wk%ty, stat=info)
-    if (allocated(wk%x2l)) deallocate(wk%x2l, stat=info)
-    if (allocated(wk%y2l)) deallocate(wk%y2l, stat=info)
-    call wk%vtx%free(info)
-    call wk%vty%free(info)
-    call wk%vx2l%free(info)
-    call wk%vy2l%free(info)
-    if (allocated(wk%wv)) then
-      do i=1,size(wk%wv)
-        call wk%wv(i)%free(info)
-      end do
-      deallocate(wk%wv, stat=info)
-    end if
-
-  end subroutine c_wrk_free
-
-  subroutine c_wrk_clone(wk,wkout,info)
-    use psb_base_mod
-    Implicit None
-
-    ! Arguments
-    class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
-    class(amg_cmlprec_wrk_type), target, intent(inout) :: wkout
-    integer(psb_ipk_), intent(out)                    :: info
-    !
-    integer(psb_ipk_) :: i
-    info = psb_success_
-
-    call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
-    call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
-    call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
-    call psb_safe_ab_cpy(wk%y2l,wkout%y2l,info)
-    call wk%vtx%clone(wkout%vtx,info)
-    call wk%vty%clone(wkout%vty,info)
-    call wk%vx2l%clone(wkout%vx2l,info)
-    call wk%vy2l%clone(wkout%vy2l,info)
-    if (allocated(wkout%wv)) then
-      do i=1,size(wkout%wv)
-        call wkout%wv(i)%free(info)
-      end do
-      deallocate( wkout%wv)
-    end if
-    allocate(wkout%wv(size(wk%wv)),stat=info)
-    do i=1,size(wk%wv)
-      call wk%wv(i)%clone(wkout%wv(i),info)
-    end do
-    return
-
-  end subroutine c_wrk_clone
-
-  subroutine c_wrk_move_alloc(wk, b,info)
-    implicit none
-    class(amg_cmlprec_wrk_type), target, intent(inout) :: wk, b
-    integer(psb_ipk_), intent(out) :: info
-
-    call b%free(info)
-    call move_alloc(wk%tx,b%tx)
-    call move_alloc(wk%ty,b%ty)
-    call move_alloc(wk%x2l,b%x2l)
-    call move_alloc(wk%y2l,b%y2l)
-    !
-    ! Should define V%move_alloc....
-    call move_alloc(wk%vtx%v,b%vtx%v)
-    call move_alloc(wk%vty%v,b%vty%v)
-    call move_alloc(wk%vx2l%v,b%vx2l%v)
-    call move_alloc(wk%vy2l%v,b%vy2l%v)
-    call move_alloc(wk%wv,b%wv)
-
-  end subroutine c_wrk_move_alloc
-
-  subroutine c_wrk_cnv(wk,info,vmold)
-    use psb_base_mod
-
-    Implicit None
-
-    ! Arguments
-    class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
-    class(psb_c_base_vect_type), intent(in), optional  :: vmold
-    !
-    integer(psb_ipk_) :: i
-
-    info = psb_success_
-    if (present(vmold)) then
-      call wk%vtx%cnv(vmold)
-      call wk%vty%cnv(vmold)
-      call wk%vx2l%cnv(vmold)
-      call wk%vy2l%cnv(vmold)
-      if (allocated(wk%wv)) then
-        do i=1,size(wk%wv)
-          call wk%wv(i)%cnv(vmold)
-        end do
-      end if
-    end if
-  end subroutine c_wrk_cnv
-
-  function c_wrk_sizeof(wk) result(val)
-    use psb_realloc_mod
-    implicit none
-    class(amg_cmlprec_wrk_type), intent(in) :: wk
-    integer(psb_epk_) :: val
-    integer :: i
-    val = 0
-    val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%tx)
-    val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%ty)
-    val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%x2l)
-    val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%y2l)
-    val = val + wk%vtx%sizeof()
-    val = val + wk%vty%sizeof()
-    val = val + wk%vx2l%sizeof()
-    val = val + wk%vy2l%sizeof()
-    if (allocated(wk%wv)) then
-      do i=1, size(wk%wv)
-        val = val + wk%wv(i)%sizeof()
-      end do
-    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_type.f90

@@ -102,6 +102,7 @@ module amg_c_prec_type
     ! The multilevel hierarchy
     !
     type(amg_c_onelev_type), allocatable :: precv(:)
+    integer(psb_ipk_)                    :: nlevs
   contains
     procedure, pass(prec)               :: psb_c_apply2_vect => amg_c_apply2_vect
     procedure, pass(prec)               :: psb_c_apply1_vect => amg_c_apply1_vect
@@ -119,6 +120,7 @@ module amg_c_prec_type
     procedure, pass(prec)               :: cmp_complexity => amg_c_cmp_compl
     procedure, pass(prec)               :: get_avg_cr => amg_c_get_avg_cr
     procedure, pass(prec)               :: cmp_avg_cr => amg_c_cmp_avg_cr
+    procedure, pass(prec)               :: set_nlevs  => amg_c_set_nlevs
     procedure, pass(prec)               :: get_nlevs  => amg_c_get_nlevs
     procedure, pass(prec)               :: get_nzeros => amg_c_get_nzeros
     procedure, pass(prec)               :: sizeof => amg_cprec_sizeof
@@ -193,7 +195,7 @@ module amg_c_prec_type
   end interface
 
   interface amg_precapply
-    subroutine amg_cprecaply2_vect(prec,x,y,desc_data,info,trans)
+    subroutine amg_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
       import :: psb_cspmat_type, psb_desc_type, &
            & psb_spk_, psb_c_vect_type, amg_cprec_type, psb_ipk_
       type(psb_desc_type),intent(in)      :: desc_data
@@ -202,8 +204,9 @@ module amg_c_prec_type
       type(psb_c_vect_type),intent(inout) :: y
       integer(psb_ipk_), intent(out)                :: info
       character(len=1), optional          :: trans
+      complex(psb_spk_),intent(inout), optional, target :: work(:)
     end subroutine amg_cprecaply2_vect
-    subroutine amg_cprecaply1_vect(prec,x,desc_data,info,trans)
+    subroutine amg_cprecaply1_vect(prec,x,desc_data,info,trans,work)
       import :: psb_cspmat_type, psb_desc_type, &
            & psb_spk_, psb_c_vect_type, amg_cprec_type, psb_ipk_
       type(psb_desc_type),intent(in)      :: desc_data
@@ -211,6 +214,7 @@ module amg_c_prec_type
       type(psb_c_vect_type),intent(inout) :: x
       integer(psb_ipk_), intent(out)                :: info
       character(len=1), optional          :: trans
+      complex(psb_spk_),intent(inout), optional, target :: work(:)
     end subroutine amg_cprecaply1_vect
     subroutine amg_cprecaply(prec,x,y,desc_data,info,trans,work)
       import :: psb_cspmat_type, psb_desc_type, psb_spk_, amg_cprec_type, psb_ipk_
@@ -433,10 +437,19 @@ contains
     class(amg_cprec_type), intent(in) :: prec
     integer(psb_ipk_) :: val
     val = 0
-    if (allocated(prec%precv)) then
-      val = size(prec%precv)
-    end if
+!!$    if (allocated(prec%precv)) then
+!!$      val = size(prec%precv)
+!!$    end if
+    val = prec%nlevs
+!!$    write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
   end function amg_c_get_nlevs
+
+  subroutine amg_c_set_nlevs(prec,nl) 
+    implicit none
+    class(amg_cprec_type), intent(inout) :: prec
+    integer(psb_ipk_) :: nl
+    prec%nlevs = nl
+  end subroutine amg_c_set_nlevs
   !
   ! Function returning the size of the amg_prec_type data structure
   ! in bytes or in number of nonzeros of the operator(s) involved.
@@ -507,7 +520,7 @@ contains
 
     real(psb_spk_) :: num, den, nmin
     type(psb_ctxt_type) :: ctxt
-    integer(psb_ipk_)   :: il
+    integer(psb_ipk_)   :: il,nl
 
     num = -sone
     den = sone
@@ -517,7 +530,10 @@ contains
       num = prec%precv(il)%base_a%get_nzeros()
       if (num >= szero) then
         den = num
-        do il=2,size(prec%precv)
+        nl = prec%get_nlevs()
+!!$        write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
+        do il=2, nl
+!!$          write(0,*) '                 ',il,associated(prec%precv(il)%base_a)
           num = num + max(0,prec%precv(il)%base_a%get_nzeros())
         end do
       end if
@@ -548,7 +564,6 @@ contains
   end function amg_c_get_avg_cr
 
   subroutine amg_c_cmp_avg_cr(prec)
-
     implicit none
     class(amg_cprec_type), intent(inout) :: prec
 
@@ -556,17 +571,18 @@ contains
     type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_)   :: il, nl, iam, np
 
-
     avgcr = szero
+    nl = prec%get_nlevs()
+    do il=2,nl
+      if (prec%precv(il)%base_desc%is_ok()) then 
+        ctxt = prec%precv(il)%base_desc%get_ctxt()
+        call psb_info(ctxt,iam,np)
+        if (iam >=0)  avgcr = avgcr + max(szero,prec%precv(il)%szratio)
+      end if
+    end do
+    avgcr = avgcr / (nl-1)
     ctxt = prec%ctxt
     call psb_info(ctxt,iam,np)
-    if (allocated(prec%precv)) then
-      nl = size(prec%precv)
-      do il=2,nl
-        avgcr = avgcr + max(szero,prec%precv(il)%szratio)
-      end do
-      avgcr = avgcr / (nl-1)
-    end if
     call psb_sum(ctxt,avgcr)
     prec%ag_data%avg_cr = avgcr/np
   end subroutine amg_c_cmp_avg_cr
@@ -584,9 +600,7 @@ contains
   !             error code.
   !
   subroutine amg_cprecfree(p,info)
-
     implicit none
-
     ! Arguments
     type(amg_cprec_type), intent(inout) :: p
     integer(psb_ipk_), intent(out)        :: info
@@ -612,9 +626,7 @@ contains
   end subroutine amg_cprecfree
 
   subroutine amg_c_prec_free(prec,info)
-
     implicit none
-
     ! Arguments
     class(amg_cprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -651,9 +663,7 @@ contains
   end subroutine amg_c_prec_free
 
   subroutine amg_c_smoothers_free(prec,info)
-
     implicit none
-
     ! Arguments
     class(amg_cprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -670,7 +680,7 @@ contains
     end if
 
     if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
+      do i=1,prec%get_nlevs()
         call prec%precv(i)%free_smoothers(info)
       end do
     end if
@@ -684,9 +694,7 @@ contains
   end subroutine amg_c_smoothers_free
 
   subroutine amg_c_hierarchy_free(prec,info)
-
     implicit none
-
     ! Arguments
     class(amg_cprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -713,11 +721,10 @@ contains
 
   end subroutine amg_c_hierarchy_free
 
-
   !
   ! Top level methods.
   !
-  subroutine amg_c_apply2_vect(prec,x,y,desc_data,info,trans)
+  subroutine amg_c_apply2_vect(prec,x,y,desc_data,info,trans,work)
     implicit none
     type(psb_desc_type),intent(in)        :: desc_data
     class(amg_cprec_type), intent(inout)  :: prec
@@ -725,6 +732,7 @@ contains
     type(psb_c_vect_type),intent(inout)   :: y
     integer(psb_ipk_), intent(out)          :: info
     character(len=1), optional              :: trans
+    complex(psb_spk_),intent(inout), optional, target :: work(:)
     Integer(psb_ipk_) :: err_act
     character(len=20) :: name='d_prec_apply'
 
@@ -732,7 +740,7 @@ contains
 
     select type(prec)
     type is (amg_cprec_type)
-      call amg_precapply(prec,x,y,desc_data,info,trans)
+      call amg_precapply(prec,x,y,desc_data,info,trans,work)
     class default
       info = psb_err_missing_override_method_
       call psb_errpush(info,name)
@@ -747,13 +755,14 @@ contains
 
   end subroutine amg_c_apply2_vect
 
-  subroutine amg_c_apply1_vect(prec,x,desc_data,info,trans)
+  subroutine amg_c_apply1_vect(prec,x,desc_data,info,trans,work)
     implicit none
     type(psb_desc_type),intent(in)          :: desc_data
     class(amg_cprec_type), intent(inout)  :: prec
     type(psb_c_vect_type),intent(inout)   :: x
     integer(psb_ipk_), intent(out)          :: info
     character(len=1), optional            :: trans
+    complex(psb_spk_),intent(inout), optional, target :: work(:)
     Integer(psb_ipk_) :: err_act
     character(len=20) :: name='d_prec_apply'
 
@@ -761,7 +770,7 @@ contains
 
     select type(prec)
     type is (amg_cprec_type)
-      call amg_precapply(prec,x,desc_data,info,trans)
+      call amg_precapply(prec,x,desc_data,info,trans,work)
     class default
       info = psb_err_missing_override_method_
       call psb_errpush(info,name)
@@ -776,7 +785,6 @@ contains
 
   end subroutine amg_c_apply1_vect
 
-
   subroutine amg_c_apply2v(prec,x,y,desc_data,info,trans,work)
     implicit none
     type(psb_desc_type),intent(in)    :: desc_data
@@ -841,7 +849,6 @@ contains
   subroutine amg_c_dump(prec,info,istart,iend,iproc,prefix,head,&
        & ac,rp,smoother,solver,tprol,&
        & global_num)
-
     implicit none
     class(amg_cprec_type), intent(in)     :: prec
     integer(psb_ipk_), intent(out)          :: info
@@ -858,7 +865,7 @@ contains
     info = 0
     ctxt = prec%ctxt
     call psb_info(ctxt,iam,np)
-    iln = size(prec%precv)
+    iln = prec%get_nlevs()
     if (present(istart)) then
       il1 = max(1,istart)
     else
@@ -882,7 +889,6 @@ contains
   end subroutine amg_c_dump
 
   subroutine amg_c_cnv(prec,info,amold,vmold,imold)
-
     implicit none
     class(amg_cprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)       :: info
@@ -894,7 +900,7 @@ contains
 
     info = psb_success_
     if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
+      do i=1,prec%get_nlevs()
         if (info == psb_success_ ) &
              & call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
       end do
@@ -903,7 +909,6 @@ contains
   end subroutine amg_c_cnv
 
   subroutine amg_c_clone(prec,precout,info)
-
     implicit none
     class(amg_cprec_type), intent(inout) :: prec
     class(psb_cprec_type), intent(inout) :: precout
@@ -915,7 +920,6 @@ contains
   end subroutine amg_c_clone
 
   subroutine amg_c_inner_clone(prec,precout,info)
-
     implicit none
     class(amg_cprec_type), intent(inout)         :: prec
     class(psb_cprec_type), target, intent(inout) :: precout
@@ -931,8 +935,9 @@ contains
       pout%ctxt          = prec%ctxt
       pout%ag_data       = prec%ag_data
       pout%outer_sweeps  = prec%outer_sweeps
+      pout%nlevs         = prec%nlevs
       if (allocated(prec%precv)) then
-        ln = size(prec%precv)
+        ln = prec%get_nlevs()
         allocate(pout%precv(ln),stat=info)
         if (info /= psb_success_) goto 9999
         if (ln >= 1) then
@@ -940,6 +945,7 @@ contains
         end if
         do lev=2, ln
           if (info /= psb_success_) exit
+!!$          write(0,*) 'Inner_clone must be checked and reimplemented! '
           call prec%precv(lev)%clone(pout%precv(lev),info)
           if (info == psb_success_) then
             pout%precv(lev)%base_a       => pout%precv(lev)%ac
@@ -1019,7 +1025,7 @@ contains
     if (psb_errstatus_fatal()) then
       info = psb_err_internal_error_; goto 9999
     end if
-    nlev   = size(prec%precv)
+    nlev   = prec%get_nlevs()
     level = 1
     do level = 1, nlev
       call prec%precv(level)%allocate_wrk(info,vmold=vmold)
@@ -1042,7 +1048,6 @@ contains
   subroutine amg_c_free_wrk(prec,info)
     use psb_base_mod
     implicit none
-
     ! Arguments
     class(amg_cprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -1059,7 +1064,7 @@ contains
     end if
 
     if (allocated(prec%precv)) then
-      nlev   = size(prec%precv)
+      nlev   = prec%get_nlevs()
       do level = 1, nlev
         call prec%precv(level)%free_wrk(info)
       end do

amgprec/amg_c_slu_solver.F90

@@ -137,7 +137,7 @@ module amg_c_slu_solver
 
   interface
     subroutine amg_c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       use psb_base_mod
       import amg_c_slu_solver_type
       implicit none 
@@ -147,6 +147,7 @@ module amg_c_slu_solver
       type(psb_c_vect_type),intent(inout)  :: y
       complex(psb_spk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)           :: trans
+      complex(psb_spk_),target, intent(inout) :: work(:)
       type(psb_c_vect_type),intent(inout) :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_c_sludist_solver.F90

@@ -1,493 +0,0 @@
-!  
-!   
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior written permission.
-!   
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
-!
-! File: amg_c_sludist_solver_mod.f90
-!
-! Module: amg_c_sludist_solver_mod
-!
-!  This module defines: 
-!  - the amg_c_sludist_solver_type data structure containing the ingredients
-!    to interface with the SuperLU_Dist package. 
-!    1. The factorization is distributed (and thus exact)
-!
-!
-!
-module amg_c_sludist_solver
-
-  use iso_c_binding
-  use amg_c_base_solver_mod
-
-#if (!defined(AMG_HAVE_SLUDIST)) || defined(PSB_IPK8) 
-
-  type, extends(amg_c_base_solver_type) :: amg_c_sludist_solver_type
-
-  end type amg_c_sludist_solver_type
-#else
-  type, extends(amg_c_base_solver_type) :: amg_c_sludist_solver_type
-    type(c_ptr)                 :: lufactors=c_null_ptr
-    integer(c_long_long)        :: symbsize=0, numsize=0
-  contains
-    procedure, pass(sv) :: build   => c_sludist_solver_bld
-    procedure, pass(sv) :: apply_a => c_sludist_solver_apply
-    procedure, pass(sv) :: apply_v => c_sludist_solver_apply_vect
-    procedure, pass(sv) :: free    => c_sludist_solver_free
-    procedure, pass(sv) :: clear_data  => c_sludist_solver_clear_data
-    procedure, pass(sv) :: descr   => c_sludist_solver_descr
-    procedure, pass(sv) :: sizeof  => c_sludist_solver_sizeof
-    procedure, nopass   :: get_fmt => c_sludist_solver_get_fmt
-    procedure, nopass   :: get_id  => c_sludist_solver_get_id
-    procedure, pass(sv) :: is_global => c_sludist_solver_is_global
-    final               :: c_sludist_solver_finalize
-  end type amg_c_sludist_solver_type
-
-
-  private :: c_sludist_solver_bld, c_sludist_solver_apply, &
-       &  c_sludist_solver_free,   c_sludist_solver_descr, &
-       &  c_sludist_solver_sizeof, c_sludist_solver_apply_vect, &
-       &  c_sludist_solver_get_fmt,  c_sludist_solver_get_id, &
-       &  c_sludist_solver_is_global, c_sludist_solver_clear_data
-  private :: c_sludist_solver_finalize
-
-
-  interface 
-    function amg_csludist_fact(n,nl,nnz,ifrst, &
-         & values,rowptr,colind,lufactors,npr,npc) &
-         & bind(c,name='amg_csludist_fact') result(info)
-      use iso_c_binding
-      integer(c_int), value :: n,nl,nnz,ifrst,npr,npc
-      integer(c_int)        :: info
-      integer(c_int)        :: rowptr(*),colind(*)
-      complex(c_float_complex)     :: values(*)
-      type(c_ptr)           :: lufactors
-    end function amg_csludist_fact
-  end interface
-
-  interface 
-    function amg_csludist_solve(itrans,n,nrhs, b, ldb, lufactors)&
-         & bind(c,name='amg_csludist_solve') result(info)
-      use iso_c_binding
-      integer(c_int)        :: info
-      integer(c_int), value :: itrans,n,nrhs,ldb
-      complex(c_float_complex)     :: b(ldb,*)
-      type(c_ptr), value    :: lufactors
-    end function amg_csludist_solve
-  end interface
-
-  interface 
-    function amg_csludist_free(lufactors)&
-         & bind(c,name='amg_csludist_free') result(info)
-      use iso_c_binding
-      integer(c_int)        :: info
-      type(c_ptr), value    :: lufactors
-    end function amg_csludist_free
-  end interface
-
-contains
-
-  subroutine c_sludist_solver_apply(alpha,sv,x,beta,y,desc_data,&
-       & trans,work,info,init,initu)
-    use psb_base_mod
-    implicit none 
-    type(psb_desc_type), intent(in)      :: desc_data
-    class(amg_c_sludist_solver_type), intent(inout) :: sv
-    complex(psb_spk_),intent(inout)         :: x(:)
-    complex(psb_spk_),intent(inout)         :: y(:)
-    complex(psb_spk_),intent(in)            :: alpha,beta
-    character(len=1),intent(in)          :: trans
-    complex(psb_spk_),target, intent(inout) :: work(:)
-    integer, intent(out)                 :: info
-    character, intent(in), optional       :: init
-    complex(psb_spk_),intent(inout), optional :: initu(:)
-
-    integer    :: n_row,n_col
-    complex(psb_spk_), pointer :: ww(:)
-    type(psb_ctxt_type) :: ctxt
-    integer             :: np,me,i, err_act
-    character           :: trans_
-    character(len=20)   :: name='c_sludist_solver_apply'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-
-    trans_ = psb_toupper(trans)
-    select case(trans_)
-    case('N')
-    case('T','C')
-    case default
-      call psb_errpush(psb_err_iarg_invalid_i_,name)
-      goto 9999
-    end select
-    !
-    ! For non-iterative solvers, init and initu are ignored.
-    !
-    
-
-    n_row = desc_data%get_local_rows()
-    n_col = desc_data%get_local_cols()
-
-    if (n_col <= size(work)) then 
-      ww => work(1:n_col)
-    else
-      allocate(ww(n_col),stat=info)
-      if (info /= psb_success_) then 
-        info=psb_err_alloc_request_
-        call psb_errpush(info,name,i_err=(/n_col/),&
-             & a_err='complex(psb_spk_)')
-        goto 9999      
-      end if
-    endif
-
-    if (info == psb_success_)&
-         & call psb_geaxpby(cone,x,czero,ww,desc_data,info)
-
-    select case(trans_)
-    case('N')
-      info = amg_csludist_solve(0,n_row,1,ww,n_row,sv%lufactors)
-    case('T')
-      info = amg_csludist_solve(1,n_row,1,ww,n_row,sv%lufactors)
-    case('C')
-      info = amg_csludist_solve(2,n_row,1,ww,n_row,sv%lufactors)
-    case default
-      call psb_errpush(psb_err_internal_error_,&
-           & name,a_err='Invalid TRANS in subsolve')
-      goto 9999
-    end select
-
-    if (info == psb_success_)&
-         & call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
-
-
-    if (info /= psb_success_) then
-      call psb_errpush(psb_err_internal_error_,&
-           & name,a_err='Error in subsolve')
-      goto 9999
-    endif
-
-    if (n_col > size(work)) then 
-      deallocate(ww)
-    endif
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine c_sludist_solver_apply
-
-  subroutine c_sludist_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-       & trans,wv,info,init,initu)
-    use psb_base_mod
-    implicit none
-    type(psb_desc_type), intent(in)      :: desc_data
-    class(amg_c_sludist_solver_type), intent(inout) :: sv
-    type(psb_c_vect_type),intent(inout)  :: x
-    type(psb_c_vect_type),intent(inout)  :: y
-    complex(psb_spk_),intent(in)            :: alpha,beta
-    character(len=1),intent(in)           :: trans
-    type(psb_c_vect_type),intent(inout) :: wv(:)
-    integer, intent(out)                  :: info
-    character, intent(in), optional                :: init
-    type(psb_c_vect_type),intent(inout), optional   :: initu
-
-    complex(psb_spk_), target :: aux(0)
-    integer    :: err_act
-    character(len=20)  :: name='c_sludist_solver_apply_vect'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    !
-    ! For non-iterative solvers, init and initu are ignored.
-    !
-    
-
-    call x%v%sync()
-    call y%v%sync()
-    call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,aux,info)
-    call y%v%set_host()
-    if (info /= 0) goto 9999
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine c_sludist_solver_apply_vect
-
-  subroutine c_sludist_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-
-    use psb_base_mod
-
-    Implicit None
-
-    ! Arguments
-    type(psb_cspmat_type), intent(inout), target        :: a
-    Type(psb_desc_type), Intent(inout)                  :: desc_a 
-    class(amg_c_sludist_solver_type), intent(inout)     :: sv
-    integer, intent(out)                                :: info
-    type(psb_cspmat_type), intent(in), target, optional :: b
-    class(psb_c_base_sparse_mat), intent(in), optional  :: amold
-    class(psb_c_base_vect_type), intent(in), optional   :: vmold
-    class(psb_i_base_vect_type), intent(in), optional  :: imold
-    ! Local variables
-    type(psb_cspmat_type) :: atmp
-    type(psb_c_csr_sparse_mat) :: acsr
-    type(psb_ctxt_type) :: ctxt
-    integer(psb_lpk_), allocatable :: gia(:), gja(:)
-    integer(psb_lpk_) :: lfrst
-    integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
-    integer(psb_ipk_) :: ifrst, ibcheck
-    integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
-    character(len=20)  :: name='c_sludist_solver_bld', ch_err
-    
-    info=psb_success_
-    call psb_erractionsave(err_act)
-    debug_unit  = psb_get_debug_unit()
-    debug_level = psb_get_debug_level()
-    ctxt       = desc_a%get_context()
-    call psb_info(ctxt, me, np)
-    npr  = np
-    npc  = 1
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),' start'
-
-
-    
-    n_row  = desc_a%get_local_rows()
-    n_col  = desc_a%get_local_cols()
-    nglob  = desc_a%get_global_rows()
-    
-    !
-    ! Strategy here is as follows: because a call to SLUDIST
-    ! as a gobal solver is mostly done  at the coarsest level,
-    ! even if we start from a problem requiring 8 bytes, chances
-    ! are that the global size will be suitable for 4 bytes
-    ! anyway, so we hope for the best, and throw an error
-    ! if something goes wrong.
-    !
-    if (nglob > huge(1_psb_ipk_)) then
-      write(0,*) me,' ',trim(name),': Error: overflow of local indices '
-      info=psb_err_internal_error_
-      call psb_errpush(info,name)
-      goto 9999
-    end if
-    
-    call a%cscnv(atmp,info,type='csr')
-    ! This in case we are dealing with AS
-    call psb_rwextd(n_row,atmp,info,b=b) 
-    call atmp%mv_to(acsr)
-    nrow_a = acsr%get_nrows()
-    nztota = acsr%get_nzeros()
-    call psb_loc_to_glob(ione,lfrst,desc_a,info)
-    
-    ! Fix the entries to call C-base SuperLU
-    call psb_realloc(nztota,gja,info)
-    call psb_loc_to_glob(acsr%ja(1:nztota),gja(1:nztota), desc_a, info, iact='I')
-    acsr%ja(1:nztota) = gja(1:nztota)
-    acsr%ja(:)  = acsr%ja(:)  - 1
-    acsr%irp(:) = acsr%irp(:) - 1
-    ifrst = lfrst - 1
-    info = amg_csludist_fact(nglob,nrow_a,nztota,ifrst,&
-         & acsr%val,acsr%irp,acsr%ja,sv%lufactors,&
-         & npr,npc)
-    
-    if (info /= psb_success_) then
-      info=psb_err_from_subroutine_
-      ch_err='amg_csludist_fact'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-    end if
-    
-    call acsr%free()
-
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),' end'
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_sludist_solver_bld
-
-  subroutine c_sludist_solver_free(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_sludist_solver_type), intent(inout) :: sv
-    integer, intent(out)                       :: info
-    Integer :: err_act
-    character(len=20)  :: name='c_sludist_solver_free'
-
-    call psb_erractionsave(err_act)
-    info = 0
-    call sv%clear_data(info)
-    
-    if (info /= psb_success_) goto 9999
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_sludist_solver_free
-
-  subroutine c_sludist_solver_clear_data(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_sludist_solver_type), intent(inout) :: sv
-    integer, intent(out)                       :: info
-    Integer :: err_act
-    character(len=20)  :: name='c_sludist_solver_clear_data'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_ 
-    if (c_associated(sv%lufactors)) info = amg_csludist_free(sv%lufactors)
-    sv%lufactors = c_null_ptr
-    
-    if (info /= psb_success_) goto 9999
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_sludist_solver_clear_data
-
-  ! 
-  function c_sludist_solver_is_global(sv) result(val)
-    implicit none 
-    class(amg_c_sludist_solver_type), intent(in) :: sv
-    logical  :: val
-
-    val = .true.
-  end function c_sludist_solver_is_global
-  
-  subroutine c_sludist_solver_finalize(sv)
-
-    Implicit None
-
-    ! Arguments
-    type(amg_c_sludist_solver_type), intent(inout) :: sv
-    integer :: info
-    Integer :: err_act
-    character(len=20)  :: name='c_sludist_solver_finalize'
-
-    call sv%free(info) 
-
-    return
-  
-  end subroutine c_sludist_solver_finalize
-
-  subroutine c_sludist_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_sludist_solver_type), intent(in) :: sv
-    integer, intent(out)                           :: info
-    integer, intent(in), optional                  :: iout
-    logical, intent(in), optional                  :: coarse
-    character(len=*), intent(in), optional         :: prefix
-
-    ! Local variables
-    integer      :: err_act
-    type(psb_ctxt_type) :: ctxt
-    integer      :: me, np
-    character(len=20), parameter :: name='amg_c_sludist_solver_descr'
-    integer :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-    
-    write(iout_,*) trim(prefix_), '  SuperLU_Dist Sparse Factorization Solver. '
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_sludist_solver_descr
-
-  function c_sludist_solver_sizeof(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_c_sludist_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer             :: i
-
-    val = 2*psb_sizeof_ip + psb_sizeof_dp
-    val = val + sv%symbsize
-    val = val + sv%numsize
-    return
-  end function c_sludist_solver_sizeof
-
-  function c_sludist_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "SuperLU_Dist solver"
-  end function c_sludist_solver_get_fmt
-
-  function c_sludist_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_sludist_
-  end function c_sludist_solver_get_id
-#endif
-end module amg_c_sludist_solver

amgprec/amg_c_umf_solver.F90

@@ -1,315 +0,0 @@
-!  
-!   
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior written permission.
-!   
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
-!
-! File: amg_c_umf_solver_mod.f90
-!
-! Module: amg_c_umf_solver_mod
-!
-!  This module defines: 
-!  - the amg_c_umf_solver_type data structure containing the ingredients
-!    to interface with the UMFPACK package. 
-!    1. The factorization is restricted to the diagonal block of the
-!       current image.
-!
-module amg_c_umf_solver
-
-  use iso_c_binding
-  use amg_c_base_solver_mod
-
-#if defined(PSB_IPK8)
-  type, extends(amg_c_base_solver_type) :: amg_c_umf_solver_type
-
-  end type amg_c_umf_solver_type
-
-#else
-  
-  type, extends(amg_c_base_solver_type) :: amg_c_umf_solver_type
-    type(c_ptr)                 :: symbolic=c_null_ptr, numeric=c_null_ptr
-    integer(c_long_long)        :: symbsize=0, numsize=0
-  contains
-    procedure, pass(sv) :: build   => amg_c_umf_solver_bld
-    procedure, pass(sv) :: apply_a => amg_c_umf_solver_apply
-    procedure, pass(sv) :: apply_v => amg_c_umf_solver_apply_vect
-    procedure, pass(sv) :: free    => c_umf_solver_free
-    procedure, pass(sv) :: clear_data  => c_umf_solver_clear_data
-    procedure, pass(sv) :: descr   => c_umf_solver_descr
-    procedure, pass(sv) :: sizeof  => c_umf_solver_sizeof
-    procedure, nopass   :: get_fmt => c_umf_solver_get_fmt
-    procedure, nopass   :: get_id  => c_umf_solver_get_id
-    final               :: c_umf_solver_finalize
-  end type amg_c_umf_solver_type
-
-
-  private :: c_umf_solver_free,   c_umf_solver_descr, &
-       &  c_umf_solver_sizeof, &
-       &  c_umf_solver_get_fmt, c_umf_solver_get_id, &
-       &  c_umf_solver_clear_data
-  private :: c_umf_solver_finalize
-
-
-
-  interface 
-    function amg_cumf_fact(n,nnz,values,rowind,colptr,&
-         & symptr,numptr,ssize,nsize)&
-         & bind(c,name='amg_cumf_fact') result(info)
-      use iso_c_binding
-      integer(c_int), value :: n,nnz
-      integer(c_int)        :: info
-      integer(c_long_long)  :: ssize, nsize
-      integer(c_int)        :: rowind(*),colptr(*)
-      complex(c_float_complex)  :: values(*)
-      type(c_ptr)           :: symptr, numptr
-    end function amg_cumf_fact
-  end interface
-
-  interface 
-    function amg_cumf_solve(itrans,n,x, b, ldb, numptr)&
-         & bind(c,name='amg_cumf_solve') result(info)
-      use iso_c_binding
-      integer(c_int)        :: info
-      integer(c_int), value :: itrans,n,ldb
-      complex(c_float_complex) :: x(*), b(ldb,*)
-      type(c_ptr), value    :: numptr
-    end function amg_cumf_solve
-  end interface
-
-  interface 
-    function amg_cumf_free(symptr, numptr)&
-         & bind(c,name='amg_cumf_free') result(info)
-      use iso_c_binding
-      integer(c_int)        :: info
-      type(c_ptr), value    :: symptr, numptr
-    end function amg_cumf_free
-  end interface
-
-  interface
-    subroutine amg_c_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
-         & trans,work,info,init,initu)
-      use psb_base_mod
-      import amg_c_umf_solver_type
-      implicit none 
-      type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_c_umf_solver_type), intent(inout) :: sv
-      complex(psb_spk_),intent(inout)         :: x(:)
-      complex(psb_spk_),intent(inout)         :: y(:)
-      complex(psb_spk_),intent(in)            :: alpha,beta
-      character(len=1),intent(in)          :: trans
-      complex(psb_spk_),target, intent(inout) :: work(:)
-      integer(psb_ipk_), intent(out)        :: info
-      character, intent(in), optional       :: init
-      complex(psb_spk_),intent(inout), optional :: initu(:)
-    end subroutine amg_c_umf_solver_apply
-  end interface
-  
-  interface
-    subroutine amg_c_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
-      use psb_base_mod
-      import amg_c_umf_solver_type
-      implicit none 
-      type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_c_umf_solver_type), intent(inout) :: sv
-      type(psb_c_vect_type),intent(inout)  :: x
-      type(psb_c_vect_type),intent(inout)  :: y
-      complex(psb_spk_),intent(in)            :: alpha,beta
-      character(len=1),intent(in)           :: trans
-      type(psb_c_vect_type),intent(inout) :: wv(:)
-      integer(psb_ipk_), intent(out)                 :: info
-      character, intent(in), optional                :: init
-      type(psb_c_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_c_umf_solver_apply_vect
-  end interface
-
-  interface 
-    subroutine amg_c_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      use psb_base_mod
-      import amg_c_umf_solver_type
-      Implicit None
-      
-      ! Arguments
-      type(psb_cspmat_type), intent(inout), target        :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_c_umf_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                        :: info
-      type(psb_cspmat_type), intent(in), target, optional :: b
-      class(psb_c_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_c_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional  :: imold
-    end subroutine amg_c_umf_solver_bld
-  end interface
-
-contains
-
-
-  subroutine c_umf_solver_free(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_umf_solver_type), intent(inout) :: sv
-    integer, intent(out)                       :: info
-    Integer :: err_act
-    character(len=20)  :: name='c_umf_solver_free'
-
-    call psb_erractionsave(err_act)
-
-    call sv%clear_data(info) 
-    
-    if (info /= psb_success_) goto 9999
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_umf_solver_free
-
-
-  subroutine c_umf_solver_clear_data(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_umf_solver_type), intent(inout) :: sv
-    integer, intent(out)                       :: info
-    Integer :: err_act
-    character(len=20)  :: name='c_umf_solver_clear_data'
-
-    call psb_erractionsave(err_act)
-    info = 0 
-    if (c_associated(sv%symbolic).and.c_associated(sv%numeric)) then 
-      info = amg_cumf_free(sv%symbolic,sv%numeric)
-      
-      if (info /= psb_success_) goto 9999
-      sv%symbolic = c_null_ptr
-      sv%numeric  = c_null_ptr
-      sv%symbsize = 0
-      sv%numsize  = 0
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_umf_solver_clear_data
-
-  subroutine c_umf_solver_finalize(sv)
-
-    Implicit None
-
-    ! Arguments
-    type(amg_c_umf_solver_type), intent(inout) :: sv
-    integer :: info
-    Integer :: err_act
-    character(len=20)  :: name='c_umf_solver_finalize'
-
-    call sv%free(info) 
-
-    return
-  
-  end subroutine c_umf_solver_finalize
-
-  subroutine c_umf_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_umf_solver_type), intent(in) :: sv
-    integer, intent(out)                       :: info
-    integer, intent(in), optional              :: iout
-    logical, intent(in), optional              :: coarse
-      character(len=*), intent(in), optional   :: prefix
-
-    ! Local variables
-    integer      :: err_act
-    character(len=20), parameter :: name='amg_c_umf_solver_descr'
-    integer :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-    
-    write(iout_,*) trim(prefix_), '  UMFPACK Sparse Factorization Solver. '
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_umf_solver_descr
-
-  function c_umf_solver_sizeof(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_c_umf_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer             :: i
-
-    val = 2*psb_sizeof_lp 
-    val = val + sv%symbsize
-    val = val + sv%numsize
-    return
-  end function c_umf_solver_sizeof
-
-  function c_umf_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "UMFPACK solver"
-  end function c_umf_solver_get_fmt
-
-  function c_umf_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_umf_
-  end function c_umf_solver_get_id
-#endif
-end module amg_c_umf_solver

amgprec/amg_d_as_smoother.f90

@@ -120,7 +120,7 @@ module amg_d_as_smoother
   end interface
   
   interface 
-    subroutine amg_d_as_smoother_restr_v(sm,x,trans,info,data)
+    subroutine amg_d_as_smoother_restr_v(sm,x,trans,work,info,data)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
            & psb_dpk_, amg_d_as_smoother_type, psb_epk_, &
            & psb_desc_type, psb_ipk_
@@ -128,6 +128,7 @@ module amg_d_as_smoother
       class(amg_d_as_smoother_type), intent(inout) :: sm
       type(psb_d_vect_type),intent(inout)          :: x
       character(len=1),intent(in)                    :: trans
+      real(psb_dpk_),target, intent(inout)          :: work(:)
       integer(psb_ipk_), intent(out)                 :: info
       integer(psb_ipk_), optional, intent(in)        :: data
     end subroutine amg_d_as_smoother_restr_v
@@ -149,7 +150,7 @@ module amg_d_as_smoother
   end interface
 
   interface 
-    subroutine amg_d_as_smoother_prol_v(sm,x,trans,info,data)
+    subroutine amg_d_as_smoother_prol_v(sm,x,trans,work,info,data)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
            & psb_dpk_, amg_d_as_smoother_type, psb_epk_, &
            & psb_desc_type, psb_ipk_
@@ -157,6 +158,7 @@ module amg_d_as_smoother
       class(amg_d_as_smoother_type), intent(inout) :: sm
       type(psb_d_vect_type),intent(inout)          :: x
       character(len=1),intent(in)                    :: trans
+      real(psb_dpk_),target, intent(inout)          :: work(:)
       integer(psb_ipk_), intent(out)                 :: info
       integer(psb_ipk_), optional, intent(in)        :: data
     end subroutine amg_d_as_smoother_prol_v
@@ -180,7 +182,7 @@ module amg_d_as_smoother
   
   interface 
     subroutine amg_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
-      & trans,sweeps,wv,info,init,initu)
+      & trans,sweeps,work,wv,info,init,initu)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
            & psb_dpk_, amg_d_as_smoother_type, psb_epk_, &
            & psb_desc_type, psb_ipk_
@@ -192,6 +194,7 @@ module amg_d_as_smoother
       real(psb_dpk_),intent(in)                     :: alpha,beta
       character(len=1),intent(in)                    :: trans
       integer(psb_ipk_), intent(in)                  :: sweeps
+      real(psb_dpk_),target, intent(inout)          :: work(:)
       type(psb_d_vect_type),intent(inout)          :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_d_base_aggregator_mod.f90

@@ -89,7 +89,7 @@ module amg_d_base_aggregator_mod
     procedure, pass(ag) :: bld_tprol   => amg_d_base_aggregator_build_tprol
     procedure, pass(ag) :: mat_bld     => amg_d_base_aggregator_mat_bld
     procedure, pass(ag) :: mat_asb     => amg_d_base_aggregator_mat_asb
-    procedure, pass(ag) :: bld_map     => amg_d_base_aggregator_bld_map
+    procedure, pass(ag) :: bld_linmap  => amg_d_base_aggregator_bld_linmap
     procedure, pass(ag) :: update_next => amg_d_base_aggregator_update_next
     procedure, pass(ag) :: clone       => amg_d_base_aggregator_clone
     procedure, pass(ag) :: free        => amg_d_base_aggregator_free
@@ -458,7 +458,7 @@ contains
   end subroutine amg_d_base_aggregator_mat_asb
 
   !
-  !> Function   bld_map
+  !> Function   bld_linmap
   !! \memberof  amg_d_base_aggregator_type
   !! \brief     Build linear map between hierarchy levels 
   !!
@@ -473,7 +473,7 @@ contains
   !!  \param map       The output map
   !!  \param info    Return code
   !!  
-  subroutine  amg_d_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
+  subroutine  amg_d_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
        & op_restr,op_prol,map,info)
     use psb_base_mod
     implicit none
@@ -484,7 +484,7 @@ contains
     type(psb_dlinmap_type), intent(out)    :: map
     integer(psb_ipk_), intent(out)       :: info
     integer(psb_ipk_) :: err_act
-    character(len=20) :: name='d_base_aggregator_bld_map'
+    character(len=20) :: name='d_base_aggregator_bld_linmap'
 
     info = psb_success_
     call psb_erractionsave(err_act)
@@ -508,7 +508,6 @@ contains
 9999 call psb_error_handler(err_act)
 
     return
-  end subroutine amg_d_base_aggregator_bld_map
-
+  end subroutine amg_d_base_aggregator_bld_linmap
 
 end module amg_d_base_aggregator_mod

amgprec/amg_d_base_ainv_mod.f90

@@ -116,7 +116,7 @@ module amg_d_base_ainv_mod
 
   interface
     subroutine amg_d_base_ainv_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         &  trans,wv,info,init,initu)
+         &  trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_dpk_,amg_d_base_ainv_solver_type, psb_d_vect_type, psb_ipk_
       type(psb_desc_type), intent(in)      :: desc_data
       class(amg_d_base_ainv_solver_type), intent(inout) :: sv
@@ -124,6 +124,7 @@ module amg_d_base_ainv_mod
       type(psb_d_vect_type),intent(inout)  :: y
       real(psb_dpk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)          :: trans
+      real(psb_dpk_),target, intent(inout) :: work(:)
       type(psb_d_vect_type),intent(inout)  :: wv(:)
       integer(psb_ipk_), intent(out)       :: info
       character, intent(in), optional      :: init

amgprec/amg_d_base_smoother_mod.f90

@@ -160,7 +160,7 @@ module amg_d_base_smoother_mod
   
   interface 
     subroutine amg_d_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
-         &  trans,sweeps,wv,info,init,initu)
+         &  trans,sweeps,work,wv,info,init,initu)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
            & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
            & amg_d_base_smoother_type, psb_ipk_
@@ -171,6 +171,7 @@ module amg_d_base_smoother_mod
       real(psb_dpk_),intent(in)                       :: alpha,beta
       character(len=1),intent(in)                      :: trans
       integer(psb_ipk_), intent(in)                    :: sweeps
+      real(psb_dpk_),target, intent(inout)            :: work(:)
       type(psb_d_vect_type),intent(inout)            :: wv(:)
       integer(psb_ipk_), intent(out)                   :: info
       character, intent(in), optional                :: init

amgprec/amg_d_base_solver_mod.f90

@@ -143,7 +143,7 @@ module amg_d_base_solver_mod
       
   interface 
     subroutine amg_d_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
            & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
            & amg_d_base_solver_type, psb_ipk_
@@ -154,6 +154,7 @@ module amg_d_base_solver_mod
       type(psb_d_vect_type),intent(inout)          :: y
       real(psb_dpk_),intent(in)                     :: alpha,beta
       character(len=1),intent(in)                    :: trans
+      real(psb_dpk_),target, intent(inout)          :: work(:)
       type(psb_d_vect_type),intent(inout)            :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_d_diag_solver.f90

@@ -77,7 +77,7 @@ module amg_d_diag_solver
 
   interface 
     subroutine amg_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& 
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
        & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
        & amg_d_diag_solver_type, psb_ipk_
@@ -87,6 +87,7 @@ module amg_d_diag_solver
       type(psb_d_vect_type), intent(inout)         :: y
       real(psb_dpk_),intent(in)                     :: alpha,beta
       character(len=1),intent(in)                    :: trans
+      real(psb_dpk_),target, intent(inout)          :: work(:)
       type(psb_d_vect_type),intent(inout)          :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_d_gs_solver.f90

@@ -106,7 +106,7 @@ module amg_d_gs_solver
 
   interface 
     subroutine amg_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_d_gs_solver_type, psb_d_vect_type, psb_dpk_, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
       implicit none 
@@ -116,13 +116,14 @@ module amg_d_gs_solver
       type(psb_d_vect_type),intent(inout)         :: y
       real(psb_dpk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      real(psb_dpk_),target, intent(inout)         :: work(:)
       type(psb_d_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init
       type(psb_d_vect_type),intent(inout), optional   :: initu
     end subroutine amg_d_gs_solver_apply_vect
     subroutine amg_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_d_bwgs_solver_type, psb_d_vect_type, psb_dpk_, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
       implicit none 
@@ -132,6 +133,7 @@ module amg_d_gs_solver
       type(psb_d_vect_type),intent(inout)         :: y
       real(psb_dpk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      real(psb_dpk_),target, intent(inout)         :: work(:)
       type(psb_d_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_d_id_solver.f90

@@ -64,7 +64,7 @@ module amg_d_id_solver
 
   interface 
     subroutine amg_d_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
            & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & 
            & amg_d_id_solver_type, psb_ipk_
@@ -74,6 +74,7 @@ module amg_d_id_solver
       type(psb_d_vect_type),intent(inout)        :: y
       real(psb_dpk_),intent(in)                   :: alpha,beta
       character(len=1),intent(in)                  :: trans
+      real(psb_dpk_),target, intent(inout)        :: work(:)
       type(psb_d_vect_type),intent(inout)        :: wv(:)
       integer(psb_ipk_), intent(out)               :: info
       character, intent(in), optional                :: init

amgprec/amg_d_ilu_solver.f90

@@ -101,7 +101,7 @@ module amg_d_ilu_solver
 
   interface 
     subroutine amg_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_d_ilu_solver_type, psb_d_vect_type, psb_dpk_, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
       implicit none 
@@ -111,6 +111,7 @@ module amg_d_ilu_solver
       type(psb_d_vect_type),intent(inout)         :: y
       real(psb_dpk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      real(psb_dpk_),target, intent(inout)         :: work(:)
       type(psb_d_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_d_inner_mod.f90

@@ -67,7 +67,7 @@ module amg_d_inner_mod
   end interface amg_mlprec_bld
 
   interface amg_mlprec_aply
-    subroutine amg_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
+    subroutine amg_dmlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
       import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
       import :: amg_dprec_type
       implicit none 
@@ -79,18 +79,19 @@ module amg_d_inner_mod
       character,intent(in)               :: trans
       real(psb_dpk_),target             :: work(:)
       integer(psb_ipk_), intent(out)     :: info
-    end subroutine amg_dmlprec_aply
-    subroutine amg_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,info)
+    end subroutine amg_dmlprec_aply_a
+    subroutine amg_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
       import :: psb_dspmat_type, psb_desc_type, &
            & psb_dpk_, psb_d_vect_type, psb_ipk_
       import :: amg_dprec_type
-      implicit none
+      implicit none 
       type(psb_desc_type),intent(in)        :: desc_data
       type(amg_dprec_type), intent(inout) :: p
       real(psb_dpk_),intent(in)            :: alpha,beta
       type(psb_d_vect_type),intent(inout) :: x
       type(psb_d_vect_type),intent(inout) :: y
       character,intent(in)                  :: trans
+      real(psb_dpk_),target                :: work(:)
       integer(psb_ipk_), intent(out)        :: info
     end subroutine amg_dmlprec_aply_vect
   end interface amg_mlprec_aply

amgprec/amg_d_jac_smoother.f90

@@ -106,7 +106,7 @@ module amg_d_jac_smoother
 
   interface
     subroutine amg_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
-         & sweeps,wv,info,init,initu)
+         & sweeps,work,wv,info,init,initu)
       import :: psb_desc_type, amg_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
            & psb_ipk_
@@ -118,6 +118,7 @@ module amg_d_jac_smoother
       real(psb_dpk_),intent(in)                      :: alpha,beta
       character(len=1),intent(in)                     :: trans
       integer(psb_ipk_), intent(in)                   :: sweeps
+      real(psb_dpk_),target, intent(inout)           :: work(:)
       type(psb_d_vect_type),intent(inout)           :: wv(:)
       integer(psb_ipk_), intent(out)                  :: info
       character, intent(in), optional                :: init

amgprec/amg_d_jac_solver.f90

@@ -101,7 +101,7 @@ module amg_d_jac_solver
 
   interface 
     subroutine amg_d_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
       implicit none 
@@ -111,6 +111,7 @@ module amg_d_jac_solver
       type(psb_d_vect_type),intent(inout)         :: y
       real(psb_dpk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      real(psb_dpk_),target, intent(inout)         :: work(:)
       type(psb_d_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_d_krm_solver.f90

@@ -131,7 +131,7 @@ module amg_d_krm_solver
 
   interface
     subroutine amg_d_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
       implicit none
@@ -141,6 +141,7 @@ module amg_d_krm_solver
       type(psb_d_vect_type),intent(inout)         :: y
       real(psb_dpk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      real(psb_dpk_),target, intent(inout)         :: work(:)
       type(psb_d_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_d_mumps_solver.F90

@@ -117,7 +117,7 @@ module amg_d_mumps_solver
 
   interface 
     subroutine d_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_d_mumps_solver_type, psb_d_vect_type, psb_dpk_, psb_spk_, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
       implicit none 
@@ -127,6 +127,7 @@ module amg_d_mumps_solver
       type(psb_d_vect_type),intent(inout)  :: y
       real(psb_dpk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)           :: trans
+      real(psb_dpk_),target, intent(inout) :: work(:)
       type(psb_d_vect_type),intent(inout) :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_d_onelev_mod.f90

@@ -155,13 +155,35 @@ module amg_d_onelev_mod
   private :: d_wrk_alloc, d_wrk_free, &
        & d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv, d_wrk_sizeof
 
+  !
+  ! Remap.
+  !  This keeps track of remapping.
+  !  Logic here is as follows:
+  !  1. AC_PRE_REMAP  need to figure out if we
+  !                really need it.
+  !  2. DESC_AC_PRE_REMAP  contains the descriptor before
+  !                remapping. Meaning that it is possible
+  !                to implement the RESTRICTOR operator by
+  !                 a. Doing LINMAP_U2V onto this one
+  !                 b. For each process, send the data to
+  !                    IDEST.
+  !                This assumes that remapping goes by
+  !                a factor of 2.
+  !                For the PROLONGATOR operators, we first
+  !                use DESC_AC, then split and send onto
+  !                the processes in DESC_AC_PRE_REMAP.
+  !
+  ! To be fixed: what happens if NP the starting processes
+  ! is not an even number? Coordinate with _X_remap in PSBLAS
+  ! 
   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
+    procedure, pass(rmp) :: clone      => d_remap_data_clone
+    procedure, pass(rmp) :: move_alloc => d_remap_move_alloc
   end type amg_d_remap_data_type
 
   type amg_d_onelev_type
@@ -207,7 +229,7 @@ module amg_d_onelev_mod
     procedure, pass(lv) :: get_wrksz => d_base_onelev_get_wrksize
     procedure, pass(lv) :: allocate_wrk   => d_base_onelev_allocate_wrk
     procedure, pass(lv) :: free_wrk       => d_base_onelev_free_wrk
-    procedure, nopass   :: stringval => amg_stringval
+    procedure, nopass   :: stringval  => amg_stringval
     procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc
 
 
@@ -231,9 +253,7 @@ module amg_d_onelev_mod
        & d_base_onelev_free_wrk
 
   interface
-    subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
-      import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_, psb_ldspmat_type, psb_lpk_
-      import :: amg_d_onelev_type
+    module subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
       implicit none
       class(amg_d_onelev_type), intent(inout), target :: lv
       type(psb_dspmat_type), intent(in) :: a
@@ -245,10 +265,7 @@ module amg_d_onelev_mod
   end interface
 
   interface
-    subroutine amg_d_base_onelev_build(lv,info,amold,vmold,imold,ilv)
-      import :: psb_d_base_sparse_mat, psb_d_base_vect_type, &
-           & psb_i_base_vect_type, psb_dpk_, amg_d_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_d_base_onelev_build(lv,info,amold,vmold,imold,ilv)
       implicit none
       class(amg_d_onelev_type), target, intent(inout) :: lv
       integer(psb_ipk_), intent(out) :: info
@@ -260,10 +277,7 @@ module amg_d_onelev_mod
   end interface
 
   interface
-    subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
       Implicit None
       ! Arguments
       class(amg_d_onelev_type), intent(in)    :: lv
@@ -276,10 +290,8 @@ module amg_d_onelev_mod
   end interface
 
   interface
-    subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,&
+         & iout,verbosity, prefix,global) 
       Implicit None
       ! Arguments
       class(amg_d_onelev_type), intent(in)    :: lv
@@ -293,10 +305,7 @@ module amg_d_onelev_mod
   end interface
 
   interface
-    subroutine amg_d_base_onelev_cnv(lv,info,amold,vmold,imold)
-      import :: amg_d_onelev_type, psb_d_base_vect_type, psb_dpk_, &
-           & psb_d_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
-      ! Arguments
+    module subroutine amg_d_base_onelev_cnv(lv,info,amold,vmold,imold)
       class(amg_d_onelev_type), intent(inout)            :: lv
       integer(psb_ipk_), intent(out)                     :: info
       class(psb_d_base_sparse_mat), intent(in), optional :: amold
@@ -306,48 +315,32 @@ module amg_d_onelev_mod
   end interface
 
   interface
-    subroutine amg_d_base_onelev_free(lv,info)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_d_base_onelev_free(lv,info)
       implicit none
-
       class(amg_d_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_d_base_onelev_free
   end interface
 
   interface
-    subroutine amg_d_base_onelev_free_smoothers(lv,info)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_d_base_onelev_free_smoothers(lv,info)
       implicit none
-
       class(amg_d_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_d_base_onelev_free_smoothers
   end interface
 
   interface
-    subroutine amg_d_base_onelev_check(lv,info)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_d_base_onelev_check(lv,info)
       Implicit None
-      ! Arguments
       class(amg_d_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)            :: info
     end subroutine amg_d_base_onelev_check
   end interface
 
   interface
-    subroutine amg_d_base_onelev_setsm(lv,val,info,pos)
-      import :: psb_dpk_, amg_d_onelev_type, amg_d_base_smoother_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_d_base_onelev_setsm(lv,val,info,pos)
       Implicit None
-
-      ! Arguments
       class(amg_d_onelev_type), target, intent(inout) :: lv
       class(amg_d_base_smoother_type), intent(in)     :: val
       integer(psb_ipk_), intent(out)                  :: info
@@ -356,12 +349,8 @@ module amg_d_onelev_mod
   end interface
 
   interface
-    subroutine amg_d_base_onelev_setsv(lv,val,info,pos)
-      import :: psb_dpk_, amg_d_onelev_type, amg_d_base_solver_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_d_base_onelev_setsv(lv,val,info,pos)
       Implicit None
-
-      ! Arguments
       class(amg_d_onelev_type), target, intent(inout) :: lv
       class(amg_d_base_solver_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
@@ -370,12 +359,8 @@ module amg_d_onelev_mod
   end interface
 
   interface
-    subroutine amg_d_base_onelev_setag(lv,val,info,pos)
-      import :: psb_dpk_, amg_d_onelev_type, amg_d_base_aggregator_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_d_base_onelev_setag(lv,val,info,pos)
       Implicit None
-
-      ! Arguments
       class(amg_d_onelev_type), target, intent(inout) :: lv
       class(amg_d_base_aggregator_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
@@ -384,13 +369,8 @@ module amg_d_onelev_mod
   end interface
 
   interface
-    subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
-      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
+    module subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
       Implicit None
-
-      ! Arguments
       class(amg_d_onelev_type), intent(inout) :: lv
       character(len=*), intent(in)              :: what
       integer(psb_ipk_), intent(in)             :: val
@@ -401,12 +381,8 @@ module amg_d_onelev_mod
   end interface
 
   interface
-    subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
-      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
+    module 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
       character(len=*), intent(in)              :: val
@@ -417,12 +393,8 @@ module amg_d_onelev_mod
   end interface
 
   interface
-    subroutine amg_d_base_onelev_csetr(lv,what,val,info,pos,idx)
-      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
+    module subroutine amg_d_base_onelev_csetr(lv,what,val,info,pos,idx)
       Implicit None
-
       class(amg_d_onelev_type), intent(inout) :: lv
       character(len=*), intent(in)              :: what
       real(psb_dpk_), intent(in)                 :: val
@@ -433,11 +405,8 @@ module amg_d_onelev_mod
   end interface
 
   interface
-    subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
+    module subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
          & solver,tprol,global_num)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
       implicit none
       class(amg_d_onelev_type), intent(in) :: lv
       integer(psb_ipk_), intent(in)          :: level
@@ -448,8 +417,7 @@ module amg_d_onelev_mod
   end interface
 
   interface
-    subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
-      import
+    module subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
       implicit none
       class(amg_d_onelev_type), target, intent(inout) :: lv
       real(psb_dpk_), intent(in)     :: alpha, beta
@@ -458,20 +426,20 @@ module amg_d_onelev_mod
       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,vtx,vty)
-      import
+    module subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
+         & work,vtx,vty)
       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
+    module subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
       implicit none
       class(amg_d_onelev_type), target, intent(inout) :: lv
       real(psb_dpk_), intent(in)     :: alpha, beta
@@ -481,17 +449,130 @@ module amg_d_onelev_mod
       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,vtx,vty)
-      import
+    module subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,&
+         & work,vtx,vty)
       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
 
+  interface 
+    module subroutine d_base_onelev_move_alloc(lv, b,info)
+      implicit none
+      class(amg_d_onelev_type), target, intent(inout) :: lv, b
+      integer(psb_ipk_), intent(out) :: info
+    end subroutine d_base_onelev_move_alloc
+  end interface
+
+  interface 
+    module subroutine d_base_onelev_allocate_wrk(lv,info,vmold)
+      implicit none
+      class(amg_d_onelev_type), target, intent(inout) :: lv
+      integer(psb_ipk_), intent(out) :: info
+      class(psb_d_base_vect_type), intent(in), optional  :: vmold
+    end subroutine d_base_onelev_allocate_wrk
+  end interface
+  
+  interface 
+    module subroutine d_base_onelev_free_wrk(lv,info)
+      implicit none
+      class(amg_d_onelev_type), target, intent(inout) :: lv
+      integer(psb_ipk_), intent(out) :: info
+    end subroutine d_base_onelev_free_wrk
+  end interface
+
+  interface 
+    module  subroutine d_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
+      Implicit None
+      ! Arguments
+      class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(in)                     :: nwv
+      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
+    end subroutine d_wrk_alloc
+  end interface
+
+  interface 
+    module subroutine d_inner_do_wrk_alloc(wk,nwv,desc,vmold)
+      class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(in)                     :: nwv
+      type(psb_desc_type), intent(in)                   :: desc
+      class(psb_d_base_vect_type), intent(in), optional  :: vmold
+    end subroutine d_inner_do_wrk_alloc
+  end interface
+
+  interface 
+    module  subroutine d_wrk_free(wk,info)
+      Implicit None
+      ! Arguments
+      class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(out)                    :: info
+    end subroutine d_wrk_free
+  end interface
+
+  interface 
+    module  subroutine d_wrk_clone(wk,wkout,info)
+      Implicit None
+      ! Arguments
+      class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
+      class(amg_dmlprec_wrk_type), target, intent(inout) :: wkout
+      integer(psb_ipk_), intent(out)                    :: info
+    end subroutine d_wrk_clone
+  end interface
+
+  interface 
+    module subroutine d_wrk_move_alloc(wk, b,info)
+      implicit none
+      class(amg_dmlprec_wrk_type), target, intent(inout) :: wk, b
+      integer(psb_ipk_), intent(out) :: info
+    end subroutine d_wrk_move_alloc
+  end interface
+
+  interface
+    module subroutine d_wrk_cnv(wk,info,vmold)
+      Implicit None
+      class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(out)                    :: info
+      class(psb_d_base_vect_type), intent(in), optional  :: vmold
+    end subroutine d_wrk_cnv
+  end interface
+
+  interface
+    module function d_wrk_sizeof(wk) result(val)
+      implicit none
+      class(amg_dmlprec_wrk_type), intent(in) :: wk
+      integer(psb_epk_) :: val
+    end  function d_wrk_sizeof
+  end interface
+
+  interface 
+    module subroutine d_remap_data_clone(rmp, remap_out, info)
+      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
+    end subroutine d_remap_data_clone
+  end interface
+
+  interface 
+    module subroutine d_remap_move_alloc(rmp, remap_out, info)
+      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
+    end subroutine d_remap_move_alloc
+  end interface
+  
+
 contains
   !
   ! Function returning the size of the amg_prec_type data structure
@@ -617,7 +698,7 @@ contains
     ! Arguments
     class(amg_d_onelev_type), target, intent(inout) :: lv
     class(amg_d_onelev_type), target, intent(inout) :: lvout
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                  :: info
 
     info = psb_success_
     if (allocated(lv%sm)) then
@@ -659,36 +740,6 @@ contains
 
   end subroutine d_base_onelev_clone
 
-  subroutine d_base_onelev_move_alloc(lv, b,info)
-    use psb_base_mod
-    implicit none
-    class(amg_d_onelev_type), target, intent(inout) :: lv, b
-    integer(psb_ipk_), intent(out) :: info
-
-    call b%free(info)
-    b%parms  = lv%parms
-    b%szratio = lv%szratio
-    if (associated(lv%sm2,lv%sm2a)) then
-      call move_alloc(lv%sm,b%sm)
-      call move_alloc(lv%sm2a,b%sm2a)
-      b%sm2 =>b%sm2a
-    else
-      call move_alloc(lv%sm,b%sm)
-      call move_alloc(lv%sm2a,b%sm2a)
-      b%sm2 =>b%sm
-    end if
-
-    call move_alloc(lv%aggr,b%aggr)
-    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%linmap,b%linmap,info)
-    b%base_a    => lv%base_a
-    b%base_desc => lv%base_desc
-
-  end subroutine d_base_onelev_move_alloc
-
-
   function d_base_onelev_get_wrksize(lv) result(val)
     implicit none
     class(amg_d_onelev_type), intent(inout) :: lv
@@ -726,269 +777,5 @@ contains
 
   end function d_base_onelev_get_wrksize
 
-  subroutine d_base_onelev_allocate_wrk(lv,info,vmold)
-    use psb_base_mod
-    implicit none
-    class(amg_d_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
-    class(psb_d_base_vect_type), intent(in), optional  :: vmold
-    !
-    integer(psb_ipk_) :: nwv, i
-    info = psb_success_
-    nwv = lv%get_wrksz()
-    if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
-    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
-
-
-  subroutine d_base_onelev_free_wrk(lv,info)
-    use psb_base_mod
-    implicit none
-    class(amg_d_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
-    !
-    integer(psb_ipk_) :: nwv,i
-    info = psb_success_
-
-    if (allocated(lv%wrk)) then
-      call lv%wrk%free(info)
-      if (info == 0) deallocate(lv%wrk,stat=info)
-    end if
-  end subroutine d_base_onelev_free_wrk
-
-  subroutine d_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
-    use psb_base_mod
-
-    Implicit None
-
-    ! Arguments
-    class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(in)                     :: nwv
-    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)
-    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)
-      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)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
-    !
-    integer(psb_ipk_) :: i
-    info = psb_success_
-
-    if (allocated(wk%tx)) deallocate(wk%tx, stat=info)
-    if (allocated(wk%ty)) deallocate(wk%ty, stat=info)
-    if (allocated(wk%x2l)) deallocate(wk%x2l, stat=info)
-    if (allocated(wk%y2l)) deallocate(wk%y2l, stat=info)
-    call wk%vtx%free(info)
-    call wk%vty%free(info)
-    call wk%vx2l%free(info)
-    call wk%vy2l%free(info)
-    if (allocated(wk%wv)) then
-      do i=1,size(wk%wv)
-        call wk%wv(i)%free(info)
-      end do
-      deallocate(wk%wv, stat=info)
-    end if
-
-  end subroutine d_wrk_free
-
-  subroutine d_wrk_clone(wk,wkout,info)
-    use psb_base_mod
-    Implicit None
-
-    ! Arguments
-    class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
-    class(amg_dmlprec_wrk_type), target, intent(inout) :: wkout
-    integer(psb_ipk_), intent(out)                    :: info
-    !
-    integer(psb_ipk_) :: i
-    info = psb_success_
-
-    call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
-    call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
-    call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
-    call psb_safe_ab_cpy(wk%y2l,wkout%y2l,info)
-    call wk%vtx%clone(wkout%vtx,info)
-    call wk%vty%clone(wkout%vty,info)
-    call wk%vx2l%clone(wkout%vx2l,info)
-    call wk%vy2l%clone(wkout%vy2l,info)
-    if (allocated(wkout%wv)) then
-      do i=1,size(wkout%wv)
-        call wkout%wv(i)%free(info)
-      end do
-      deallocate( wkout%wv)
-    end if
-    allocate(wkout%wv(size(wk%wv)),stat=info)
-    do i=1,size(wk%wv)
-      call wk%wv(i)%clone(wkout%wv(i),info)
-    end do
-    return
-
-  end subroutine d_wrk_clone
-
-  subroutine d_wrk_move_alloc(wk, b,info)
-    implicit none
-    class(amg_dmlprec_wrk_type), target, intent(inout) :: wk, b
-    integer(psb_ipk_), intent(out) :: info
-
-    call b%free(info)
-    call move_alloc(wk%tx,b%tx)
-    call move_alloc(wk%ty,b%ty)
-    call move_alloc(wk%x2l,b%x2l)
-    call move_alloc(wk%y2l,b%y2l)
-    !
-    ! Should define V%move_alloc....
-    call move_alloc(wk%vtx%v,b%vtx%v)
-    call move_alloc(wk%vty%v,b%vty%v)
-    call move_alloc(wk%vx2l%v,b%vx2l%v)
-    call move_alloc(wk%vy2l%v,b%vy2l%v)
-    call move_alloc(wk%wv,b%wv)
-
-  end subroutine d_wrk_move_alloc
-
-  subroutine d_wrk_cnv(wk,info,vmold)
-    use psb_base_mod
-
-    Implicit None
-
-    ! Arguments
-    class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
-    class(psb_d_base_vect_type), intent(in), optional  :: vmold
-    !
-    integer(psb_ipk_) :: i
-
-    info = psb_success_
-    if (present(vmold)) then
-      call wk%vtx%cnv(vmold)
-      call wk%vty%cnv(vmold)
-      call wk%vx2l%cnv(vmold)
-      call wk%vy2l%cnv(vmold)
-      if (allocated(wk%wv)) then
-        do i=1,size(wk%wv)
-          call wk%wv(i)%cnv(vmold)
-        end do
-      end if
-    end if
-  end subroutine d_wrk_cnv
-
-  function d_wrk_sizeof(wk) result(val)
-    use psb_realloc_mod
-    implicit none
-    class(amg_dmlprec_wrk_type), intent(in) :: wk
-    integer(psb_epk_) :: val
-    integer :: i
-    val = 0
-    val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%tx)
-    val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%ty)
-    val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%x2l)
-    val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%y2l)
-    val = val + wk%vtx%sizeof()
-    val = val + wk%vty%sizeof()
-    val = val + wk%vx2l%sizeof()
-    val = val + wk%vy2l%sizeof()
-    if (allocated(wk%wv)) then
-      do i=1, size(wk%wv)
-        val = val + wk%wv(i)%sizeof()
-      end do
-    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_parmatch_aggregator_mod.F90

@@ -136,7 +136,7 @@ module amg_d_parmatch_aggregator_mod
     procedure, pass(ag) :: mat_bld      => amg_d_parmatch_aggregator_mat_bld
     procedure, pass(ag) :: mat_asb      => amg_d_parmatch_aggregator_mat_asb
     procedure, pass(ag) :: inner_mat_asb      => amg_d_parmatch_aggregator_inner_mat_asb
-    procedure, pass(ag) :: bld_map      => amg_d_parmatch_aggregator_bld_map
+    procedure, pass(ag) :: bld_linmap   => amg_d_parmatch_aggregator_bld_linmap
     procedure, pass(ag) :: csetc        => amg_d_parmatch_aggr_csetc
     procedure, pass(ag) :: cseti        => amg_d_parmatch_aggr_cseti
     procedure, pass(ag) :: default      => amg_d_parmatch_aggr_set_default
@@ -643,7 +643,7 @@ contains
     end select
   end subroutine amg_d_parmatch_aggregator_clone
 
-  subroutine  amg_d_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
+  subroutine  amg_d_parmatch_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
        & op_restr,op_prol,map,info)
     use psb_base_mod
     implicit none
@@ -654,7 +654,7 @@ contains
     type(psb_dlinmap_type), intent(out)     :: map
     integer(psb_ipk_), intent(out)          :: info
     integer(psb_ipk_) :: err_act
-    character(len=20) :: name='d_parmatch_aggregator_bld_map'
+    character(len=20) :: name='d_parmatch_aggregator_bld_linmap'
 
     info = psb_success_
     call psb_erractionsave(err_act)
@@ -680,5 +680,5 @@ contains
 9999 call psb_error_handler(err_act)
 
     return
-  end subroutine amg_d_parmatch_aggregator_bld_map
+  end subroutine amg_d_parmatch_aggregator_bld_linmap
 end module amg_d_parmatch_aggregator_mod

amgprec/amg_d_poly_smoother.f90

@@ -94,7 +94,7 @@ module amg_d_poly_smoother
 
   interface
     subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
-         & sweeps,wv,info,init,initu)
+         & sweeps,work,wv,info,init,initu)
       import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
            & psb_ipk_
@@ -106,6 +106,7 @@ module amg_d_poly_smoother
       real(psb_dpk_),intent(in)                      :: alpha,beta
       character(len=1),intent(in)                     :: trans
       integer(psb_ipk_), intent(in)                   :: sweeps
+      real(psb_dpk_),target, intent(inout)           :: work(:)
       type(psb_d_vect_type),intent(inout)           :: wv(:)
       integer(psb_ipk_), intent(out)                  :: info
       character, intent(in), optional                :: init

amgprec/amg_d_prec_type.f90

@@ -102,6 +102,7 @@ module amg_d_prec_type
     ! The multilevel hierarchy
     !
     type(amg_d_onelev_type), allocatable :: precv(:)
+    integer(psb_ipk_)                    :: nlevs
   contains
     procedure, pass(prec)               :: psb_d_apply2_vect => amg_d_apply2_vect
     procedure, pass(prec)               :: psb_d_apply1_vect => amg_d_apply1_vect
@@ -119,6 +120,7 @@ module amg_d_prec_type
     procedure, pass(prec)               :: cmp_complexity => amg_d_cmp_compl
     procedure, pass(prec)               :: get_avg_cr => amg_d_get_avg_cr
     procedure, pass(prec)               :: cmp_avg_cr => amg_d_cmp_avg_cr
+    procedure, pass(prec)               :: set_nlevs  => amg_d_set_nlevs
     procedure, pass(prec)               :: get_nlevs  => amg_d_get_nlevs
     procedure, pass(prec)               :: get_nzeros => amg_d_get_nzeros
     procedure, pass(prec)               :: sizeof => amg_dprec_sizeof
@@ -193,7 +195,7 @@ module amg_d_prec_type
   end interface
 
   interface amg_precapply
-    subroutine amg_dprecaply2_vect(prec,x,y,desc_data,info,trans)
+    subroutine amg_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
       import :: psb_dspmat_type, psb_desc_type, &
            & psb_dpk_, psb_d_vect_type, amg_dprec_type, psb_ipk_
       type(psb_desc_type),intent(in)      :: desc_data
@@ -202,8 +204,9 @@ module amg_d_prec_type
       type(psb_d_vect_type),intent(inout) :: y
       integer(psb_ipk_), intent(out)                :: info
       character(len=1), optional          :: trans
+      real(psb_dpk_),intent(inout), optional, target :: work(:)
     end subroutine amg_dprecaply2_vect
-    subroutine amg_dprecaply1_vect(prec,x,desc_data,info,trans)
+    subroutine amg_dprecaply1_vect(prec,x,desc_data,info,trans,work)
       import :: psb_dspmat_type, psb_desc_type, &
            & psb_dpk_, psb_d_vect_type, amg_dprec_type, psb_ipk_
       type(psb_desc_type),intent(in)      :: desc_data
@@ -211,6 +214,7 @@ module amg_d_prec_type
       type(psb_d_vect_type),intent(inout) :: x
       integer(psb_ipk_), intent(out)                :: info
       character(len=1), optional          :: trans
+      real(psb_dpk_),intent(inout), optional, target :: work(:)
     end subroutine amg_dprecaply1_vect
     subroutine amg_dprecaply(prec,x,y,desc_data,info,trans,work)
       import :: psb_dspmat_type, psb_desc_type, psb_dpk_, amg_dprec_type, psb_ipk_
@@ -433,10 +437,19 @@ contains
     class(amg_dprec_type), intent(in) :: prec
     integer(psb_ipk_) :: val
     val = 0
-    if (allocated(prec%precv)) then
-      val = size(prec%precv)
-    end if
+!!$    if (allocated(prec%precv)) then
+!!$      val = size(prec%precv)
+!!$    end if
+    val = prec%nlevs
+!!$    write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
   end function amg_d_get_nlevs
+
+  subroutine amg_d_set_nlevs(prec,nl) 
+    implicit none
+    class(amg_dprec_type), intent(inout) :: prec
+    integer(psb_ipk_) :: nl
+    prec%nlevs = nl
+  end subroutine amg_d_set_nlevs
   !
   ! Function returning the size of the amg_prec_type data structure
   ! in bytes or in number of nonzeros of the operator(s) involved.
@@ -507,7 +520,7 @@ contains
 
     real(psb_dpk_) :: num, den, nmin
     type(psb_ctxt_type) :: ctxt
-    integer(psb_ipk_)   :: il
+    integer(psb_ipk_)   :: il,nl
 
     num = -done
     den = done
@@ -517,7 +530,10 @@ contains
       num = prec%precv(il)%base_a%get_nzeros()
       if (num >= dzero) then
         den = num
-        do il=2,size(prec%precv)
+        nl = prec%get_nlevs()
+!!$        write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
+        do il=2, nl
+!!$          write(0,*) '                 ',il,associated(prec%precv(il)%base_a)
           num = num + max(0,prec%precv(il)%base_a%get_nzeros())
         end do
       end if
@@ -548,7 +564,6 @@ contains
   end function amg_d_get_avg_cr
 
   subroutine amg_d_cmp_avg_cr(prec)
-
     implicit none
     class(amg_dprec_type), intent(inout) :: prec
 
@@ -556,17 +571,18 @@ contains
     type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_)   :: il, nl, iam, np
 
-
     avgcr = dzero
+    nl = prec%get_nlevs()
+    do il=2,nl
+      if (prec%precv(il)%base_desc%is_ok()) then 
+        ctxt = prec%precv(il)%base_desc%get_ctxt()
+        call psb_info(ctxt,iam,np)
+        if (iam >=0)  avgcr = avgcr + max(dzero,prec%precv(il)%szratio)
+      end if
+    end do
+    avgcr = avgcr / (nl-1)
     ctxt = prec%ctxt
     call psb_info(ctxt,iam,np)
-    if (allocated(prec%precv)) then
-      nl = size(prec%precv)
-      do il=2,nl
-        avgcr = avgcr + max(dzero,prec%precv(il)%szratio)
-      end do
-      avgcr = avgcr / (nl-1)
-    end if
     call psb_sum(ctxt,avgcr)
     prec%ag_data%avg_cr = avgcr/np
   end subroutine amg_d_cmp_avg_cr
@@ -584,9 +600,7 @@ contains
   !             error code.
   !
   subroutine amg_dprecfree(p,info)
-
     implicit none
-
     ! Arguments
     type(amg_dprec_type), intent(inout) :: p
     integer(psb_ipk_), intent(out)        :: info
@@ -612,9 +626,7 @@ contains
   end subroutine amg_dprecfree
 
   subroutine amg_d_prec_free(prec,info)
-
     implicit none
-
     ! Arguments
     class(amg_dprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -651,9 +663,7 @@ contains
   end subroutine amg_d_prec_free
 
   subroutine amg_d_smoothers_free(prec,info)
-
     implicit none
-
     ! Arguments
     class(amg_dprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -670,7 +680,7 @@ contains
     end if
 
     if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
+      do i=1,prec%get_nlevs()
         call prec%precv(i)%free_smoothers(info)
       end do
     end if
@@ -684,9 +694,7 @@ contains
   end subroutine amg_d_smoothers_free
 
   subroutine amg_d_hierarchy_free(prec,info)
-
     implicit none
-
     ! Arguments
     class(amg_dprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -713,11 +721,10 @@ contains
 
   end subroutine amg_d_hierarchy_free
 
-
   !
   ! Top level methods.
   !
-  subroutine amg_d_apply2_vect(prec,x,y,desc_data,info,trans)
+  subroutine amg_d_apply2_vect(prec,x,y,desc_data,info,trans,work)
     implicit none
     type(psb_desc_type),intent(in)        :: desc_data
     class(amg_dprec_type), intent(inout)  :: prec
@@ -725,6 +732,7 @@ contains
     type(psb_d_vect_type),intent(inout)   :: y
     integer(psb_ipk_), intent(out)          :: info
     character(len=1), optional              :: trans
+    real(psb_dpk_),intent(inout), optional, target :: work(:)
     Integer(psb_ipk_) :: err_act
     character(len=20) :: name='d_prec_apply'
 
@@ -732,7 +740,7 @@ contains
 
     select type(prec)
     type is (amg_dprec_type)
-      call amg_precapply(prec,x,y,desc_data,info,trans)
+      call amg_precapply(prec,x,y,desc_data,info,trans,work)
     class default
       info = psb_err_missing_override_method_
       call psb_errpush(info,name)
@@ -747,13 +755,14 @@ contains
 
   end subroutine amg_d_apply2_vect
 
-  subroutine amg_d_apply1_vect(prec,x,desc_data,info,trans)
+  subroutine amg_d_apply1_vect(prec,x,desc_data,info,trans,work)
     implicit none
     type(psb_desc_type),intent(in)          :: desc_data
     class(amg_dprec_type), intent(inout)  :: prec
     type(psb_d_vect_type),intent(inout)   :: x
     integer(psb_ipk_), intent(out)          :: info
     character(len=1), optional            :: trans
+    real(psb_dpk_),intent(inout), optional, target :: work(:)
     Integer(psb_ipk_) :: err_act
     character(len=20) :: name='d_prec_apply'
 
@@ -761,7 +770,7 @@ contains
 
     select type(prec)
     type is (amg_dprec_type)
-      call amg_precapply(prec,x,desc_data,info,trans)
+      call amg_precapply(prec,x,desc_data,info,trans,work)
     class default
       info = psb_err_missing_override_method_
       call psb_errpush(info,name)
@@ -776,7 +785,6 @@ contains
 
   end subroutine amg_d_apply1_vect
 
-
   subroutine amg_d_apply2v(prec,x,y,desc_data,info,trans,work)
     implicit none
     type(psb_desc_type),intent(in)    :: desc_data
@@ -841,7 +849,6 @@ contains
   subroutine amg_d_dump(prec,info,istart,iend,iproc,prefix,head,&
        & ac,rp,smoother,solver,tprol,&
        & global_num)
-
     implicit none
     class(amg_dprec_type), intent(in)     :: prec
     integer(psb_ipk_), intent(out)          :: info
@@ -858,7 +865,7 @@ contains
     info = 0
     ctxt = prec%ctxt
     call psb_info(ctxt,iam,np)
-    iln = size(prec%precv)
+    iln = prec%get_nlevs()
     if (present(istart)) then
       il1 = max(1,istart)
     else
@@ -882,7 +889,6 @@ contains
   end subroutine amg_d_dump
 
   subroutine amg_d_cnv(prec,info,amold,vmold,imold)
-
     implicit none
     class(amg_dprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)       :: info
@@ -894,7 +900,7 @@ contains
 
     info = psb_success_
     if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
+      do i=1,prec%get_nlevs()
         if (info == psb_success_ ) &
              & call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
       end do
@@ -903,7 +909,6 @@ contains
   end subroutine amg_d_cnv
 
   subroutine amg_d_clone(prec,precout,info)
-
     implicit none
     class(amg_dprec_type), intent(inout) :: prec
     class(psb_dprec_type), intent(inout) :: precout
@@ -915,7 +920,6 @@ contains
   end subroutine amg_d_clone
 
   subroutine amg_d_inner_clone(prec,precout,info)
-
     implicit none
     class(amg_dprec_type), intent(inout)         :: prec
     class(psb_dprec_type), target, intent(inout) :: precout
@@ -931,8 +935,9 @@ contains
       pout%ctxt          = prec%ctxt
       pout%ag_data       = prec%ag_data
       pout%outer_sweeps  = prec%outer_sweeps
+      pout%nlevs         = prec%nlevs
       if (allocated(prec%precv)) then
-        ln = size(prec%precv)
+        ln = prec%get_nlevs()
         allocate(pout%precv(ln),stat=info)
         if (info /= psb_success_) goto 9999
         if (ln >= 1) then
@@ -940,6 +945,7 @@ contains
         end if
         do lev=2, ln
           if (info /= psb_success_) exit
+!!$          write(0,*) 'Inner_clone must be checked and reimplemented! '
           call prec%precv(lev)%clone(pout%precv(lev),info)
           if (info == psb_success_) then
             pout%precv(lev)%base_a       => pout%precv(lev)%ac
@@ -1019,7 +1025,7 @@ contains
     if (psb_errstatus_fatal()) then
       info = psb_err_internal_error_; goto 9999
     end if
-    nlev   = size(prec%precv)
+    nlev   = prec%get_nlevs()
     level = 1
     do level = 1, nlev
       call prec%precv(level)%allocate_wrk(info,vmold=vmold)
@@ -1042,7 +1048,6 @@ contains
   subroutine amg_d_free_wrk(prec,info)
     use psb_base_mod
     implicit none
-
     ! Arguments
     class(amg_dprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -1059,7 +1064,7 @@ contains
     end if
 
     if (allocated(prec%precv)) then
-      nlev   = size(prec%precv)
+      nlev   = prec%get_nlevs()
       do level = 1, nlev
         call prec%precv(level)%free_wrk(info)
       end do

amgprec/amg_d_slu_solver.F90

@@ -137,7 +137,7 @@ module amg_d_slu_solver
 
   interface
     subroutine amg_d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       use psb_base_mod
       import amg_d_slu_solver_type
       implicit none 
@@ -147,6 +147,7 @@ module amg_d_slu_solver
       type(psb_d_vect_type),intent(inout)  :: y
       real(psb_dpk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)           :: trans
+      real(psb_dpk_),target, intent(inout) :: work(:)
       type(psb_d_vect_type),intent(inout) :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_d_sludist_solver.F90

@@ -212,21 +212,21 @@ contains
   end subroutine d_sludist_solver_apply
 
   subroutine d_sludist_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-       & trans,wv,info,init,initu)
+       & trans,work,wv,info,init,initu)
     use psb_base_mod
-    implicit none
+    implicit none 
     type(psb_desc_type), intent(in)      :: desc_data
     class(amg_d_sludist_solver_type), intent(inout) :: sv
     type(psb_d_vect_type),intent(inout)  :: x
     type(psb_d_vect_type),intent(inout)  :: y
     real(psb_dpk_),intent(in)            :: alpha,beta
     character(len=1),intent(in)           :: trans
+    real(psb_dpk_),target, intent(inout) :: work(:)
     type(psb_d_vect_type),intent(inout) :: wv(:)
     integer, intent(out)                  :: info
     character, intent(in), optional                :: init
     type(psb_d_vect_type),intent(inout), optional   :: initu
 
-    real(psb_dpk_), target :: aux(0)
     integer    :: err_act
     character(len=20)  :: name='d_sludist_solver_apply_vect'
 
@@ -240,7 +240,7 @@ contains
 
     call x%v%sync()
     call y%v%sync()
-    call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,aux,info)
+    call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
     call y%v%set_host()
     if (info /= 0) goto 9999
 

amgprec/amg_d_umf_solver.F90

@@ -138,7 +138,7 @@ module amg_d_umf_solver
   
   interface
     subroutine amg_d_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       use psb_base_mod
       import amg_d_umf_solver_type
       implicit none 
@@ -148,6 +148,7 @@ module amg_d_umf_solver
       type(psb_d_vect_type),intent(inout)  :: y
       real(psb_dpk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)           :: trans
+      real(psb_dpk_),target, intent(inout) :: work(:)
       type(psb_d_vect_type),intent(inout) :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_s_as_smoother.f90

@@ -120,7 +120,7 @@ module amg_s_as_smoother
   end interface
   
   interface 
-    subroutine amg_s_as_smoother_restr_v(sm,x,trans,info,data)
+    subroutine amg_s_as_smoother_restr_v(sm,x,trans,work,info,data)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
            & psb_spk_, amg_s_as_smoother_type, psb_epk_, &
            & psb_desc_type, psb_ipk_
@@ -128,6 +128,7 @@ module amg_s_as_smoother
       class(amg_s_as_smoother_type), intent(inout) :: sm
       type(psb_s_vect_type),intent(inout)          :: x
       character(len=1),intent(in)                    :: trans
+      real(psb_spk_),target, intent(inout)          :: work(:)
       integer(psb_ipk_), intent(out)                 :: info
       integer(psb_ipk_), optional, intent(in)        :: data
     end subroutine amg_s_as_smoother_restr_v
@@ -149,7 +150,7 @@ module amg_s_as_smoother
   end interface
 
   interface 
-    subroutine amg_s_as_smoother_prol_v(sm,x,trans,info,data)
+    subroutine amg_s_as_smoother_prol_v(sm,x,trans,work,info,data)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
            & psb_spk_, amg_s_as_smoother_type, psb_epk_, &
            & psb_desc_type, psb_ipk_
@@ -157,6 +158,7 @@ module amg_s_as_smoother
       class(amg_s_as_smoother_type), intent(inout) :: sm
       type(psb_s_vect_type),intent(inout)          :: x
       character(len=1),intent(in)                    :: trans
+      real(psb_spk_),target, intent(inout)          :: work(:)
       integer(psb_ipk_), intent(out)                 :: info
       integer(psb_ipk_), optional, intent(in)        :: data
     end subroutine amg_s_as_smoother_prol_v
@@ -180,7 +182,7 @@ module amg_s_as_smoother
   
   interface 
     subroutine amg_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
-      & trans,sweeps,wv,info,init,initu)
+      & trans,sweeps,work,wv,info,init,initu)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
            & psb_spk_, amg_s_as_smoother_type, psb_epk_, &
            & psb_desc_type, psb_ipk_
@@ -192,6 +194,7 @@ module amg_s_as_smoother
       real(psb_spk_),intent(in)                     :: alpha,beta
       character(len=1),intent(in)                    :: trans
       integer(psb_ipk_), intent(in)                  :: sweeps
+      real(psb_spk_),target, intent(inout)          :: work(:)
       type(psb_s_vect_type),intent(inout)          :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_s_base_aggregator_mod.f90

@@ -89,7 +89,7 @@ module amg_s_base_aggregator_mod
     procedure, pass(ag) :: bld_tprol   => amg_s_base_aggregator_build_tprol
     procedure, pass(ag) :: mat_bld     => amg_s_base_aggregator_mat_bld
     procedure, pass(ag) :: mat_asb     => amg_s_base_aggregator_mat_asb
-    procedure, pass(ag) :: bld_map     => amg_s_base_aggregator_bld_map
+    procedure, pass(ag) :: bld_linmap  => amg_s_base_aggregator_bld_linmap
     procedure, pass(ag) :: update_next => amg_s_base_aggregator_update_next
     procedure, pass(ag) :: clone       => amg_s_base_aggregator_clone
     procedure, pass(ag) :: free        => amg_s_base_aggregator_free
@@ -458,7 +458,7 @@ contains
   end subroutine amg_s_base_aggregator_mat_asb
 
   !
-  !> Function   bld_map
+  !> Function   bld_linmap
   !! \memberof  amg_s_base_aggregator_type
   !! \brief     Build linear map between hierarchy levels 
   !!
@@ -473,7 +473,7 @@ contains
   !!  \param map       The output map
   !!  \param info    Return code
   !!  
-  subroutine  amg_s_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
+  subroutine  amg_s_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
        & op_restr,op_prol,map,info)
     use psb_base_mod
     implicit none
@@ -484,7 +484,7 @@ contains
     type(psb_slinmap_type), intent(out)    :: map
     integer(psb_ipk_), intent(out)       :: info
     integer(psb_ipk_) :: err_act
-    character(len=20) :: name='s_base_aggregator_bld_map'
+    character(len=20) :: name='s_base_aggregator_bld_linmap'
 
     info = psb_success_
     call psb_erractionsave(err_act)
@@ -508,7 +508,6 @@ contains
 9999 call psb_error_handler(err_act)
 
     return
-  end subroutine amg_s_base_aggregator_bld_map
-
+  end subroutine amg_s_base_aggregator_bld_linmap
 
 end module amg_s_base_aggregator_mod

amgprec/amg_s_base_ainv_mod.f90

@@ -116,7 +116,7 @@ module amg_s_base_ainv_mod
 
   interface
     subroutine amg_s_base_ainv_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         &  trans,wv,info,init,initu)
+         &  trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_spk_,amg_s_base_ainv_solver_type, psb_s_vect_type, psb_ipk_
       type(psb_desc_type), intent(in)      :: desc_data
       class(amg_s_base_ainv_solver_type), intent(inout) :: sv
@@ -124,6 +124,7 @@ module amg_s_base_ainv_mod
       type(psb_s_vect_type),intent(inout)  :: y
       real(psb_spk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)          :: trans
+      real(psb_spk_),target, intent(inout) :: work(:)
       type(psb_s_vect_type),intent(inout)  :: wv(:)
       integer(psb_ipk_), intent(out)       :: info
       character, intent(in), optional      :: init

amgprec/amg_s_base_smoother_mod.f90

@@ -160,7 +160,7 @@ module amg_s_base_smoother_mod
   
   interface 
     subroutine amg_s_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
-         &  trans,sweeps,wv,info,init,initu)
+         &  trans,sweeps,work,wv,info,init,initu)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
            & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
            & amg_s_base_smoother_type, psb_ipk_
@@ -171,6 +171,7 @@ module amg_s_base_smoother_mod
       real(psb_spk_),intent(in)                       :: alpha,beta
       character(len=1),intent(in)                      :: trans
       integer(psb_ipk_), intent(in)                    :: sweeps
+      real(psb_spk_),target, intent(inout)            :: work(:)
       type(psb_s_vect_type),intent(inout)            :: wv(:)
       integer(psb_ipk_), intent(out)                   :: info
       character, intent(in), optional                :: init

amgprec/amg_s_base_solver_mod.f90

@@ -143,7 +143,7 @@ module amg_s_base_solver_mod
       
   interface 
     subroutine amg_s_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
            & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
            & amg_s_base_solver_type, psb_ipk_
@@ -154,6 +154,7 @@ module amg_s_base_solver_mod
       type(psb_s_vect_type),intent(inout)          :: y
       real(psb_spk_),intent(in)                     :: alpha,beta
       character(len=1),intent(in)                    :: trans
+      real(psb_spk_),target, intent(inout)          :: work(:)
       type(psb_s_vect_type),intent(inout)            :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_s_diag_solver.f90

@@ -77,7 +77,7 @@ module amg_s_diag_solver
 
   interface 
     subroutine amg_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& 
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
        & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
        & amg_s_diag_solver_type, psb_ipk_
@@ -87,6 +87,7 @@ module amg_s_diag_solver
       type(psb_s_vect_type), intent(inout)         :: y
       real(psb_spk_),intent(in)                     :: alpha,beta
       character(len=1),intent(in)                    :: trans
+      real(psb_spk_),target, intent(inout)          :: work(:)
       type(psb_s_vect_type),intent(inout)          :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_s_gs_solver.f90

@@ -106,7 +106,7 @@ module amg_s_gs_solver
 
   interface 
     subroutine amg_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_s_gs_solver_type, psb_s_vect_type, psb_spk_, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
       implicit none 
@@ -116,13 +116,14 @@ module amg_s_gs_solver
       type(psb_s_vect_type),intent(inout)         :: y
       real(psb_spk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      real(psb_spk_),target, intent(inout)         :: work(:)
       type(psb_s_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init
       type(psb_s_vect_type),intent(inout), optional   :: initu
     end subroutine amg_s_gs_solver_apply_vect
     subroutine amg_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_s_bwgs_solver_type, psb_s_vect_type, psb_spk_, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
       implicit none 
@@ -132,6 +133,7 @@ module amg_s_gs_solver
       type(psb_s_vect_type),intent(inout)         :: y
       real(psb_spk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      real(psb_spk_),target, intent(inout)         :: work(:)
       type(psb_s_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_s_id_solver.f90

@@ -64,7 +64,7 @@ module amg_s_id_solver
 
   interface 
     subroutine amg_s_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
            & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & 
            & amg_s_id_solver_type, psb_ipk_
@@ -74,6 +74,7 @@ module amg_s_id_solver
       type(psb_s_vect_type),intent(inout)        :: y
       real(psb_spk_),intent(in)                   :: alpha,beta
       character(len=1),intent(in)                  :: trans
+      real(psb_spk_),target, intent(inout)        :: work(:)
       type(psb_s_vect_type),intent(inout)        :: wv(:)
       integer(psb_ipk_), intent(out)               :: info
       character, intent(in), optional                :: init

amgprec/amg_s_ilu_solver.f90

@@ -101,7 +101,7 @@ module amg_s_ilu_solver
 
   interface 
     subroutine amg_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_s_ilu_solver_type, psb_s_vect_type, psb_spk_, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
       implicit none 
@@ -111,6 +111,7 @@ module amg_s_ilu_solver
       type(psb_s_vect_type),intent(inout)         :: y
       real(psb_spk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      real(psb_spk_),target, intent(inout)         :: work(:)
       type(psb_s_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_s_inner_mod.f90

@@ -67,7 +67,7 @@ module amg_s_inner_mod
   end interface amg_mlprec_bld
 
   interface amg_mlprec_aply
-    subroutine amg_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
+    subroutine amg_smlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
       import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
       import :: amg_sprec_type
       implicit none 
@@ -79,18 +79,19 @@ module amg_s_inner_mod
       character,intent(in)               :: trans
       real(psb_spk_),target             :: work(:)
       integer(psb_ipk_), intent(out)     :: info
-    end subroutine amg_smlprec_aply
-    subroutine amg_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,info)
+    end subroutine amg_smlprec_aply_a
+    subroutine amg_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
       import :: psb_sspmat_type, psb_desc_type, &
            & psb_spk_, psb_s_vect_type, psb_ipk_
       import :: amg_sprec_type
-      implicit none
+      implicit none 
       type(psb_desc_type),intent(in)        :: desc_data
       type(amg_sprec_type), intent(inout) :: p
       real(psb_spk_),intent(in)            :: alpha,beta
       type(psb_s_vect_type),intent(inout) :: x
       type(psb_s_vect_type),intent(inout) :: y
       character,intent(in)                  :: trans
+      real(psb_spk_),target                :: work(:)
       integer(psb_ipk_), intent(out)        :: info
     end subroutine amg_smlprec_aply_vect
   end interface amg_mlprec_aply

amgprec/amg_s_jac_smoother.f90

@@ -106,7 +106,7 @@ module amg_s_jac_smoother
 
   interface
     subroutine amg_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
-         & sweeps,wv,info,init,initu)
+         & sweeps,work,wv,info,init,initu)
       import :: psb_desc_type, amg_s_jac_smoother_type, psb_s_vect_type, psb_spk_, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
            & psb_ipk_
@@ -118,6 +118,7 @@ module amg_s_jac_smoother
       real(psb_spk_),intent(in)                      :: alpha,beta
       character(len=1),intent(in)                     :: trans
       integer(psb_ipk_), intent(in)                   :: sweeps
+      real(psb_spk_),target, intent(inout)           :: work(:)
       type(psb_s_vect_type),intent(inout)           :: wv(:)
       integer(psb_ipk_), intent(out)                  :: info
       character, intent(in), optional                :: init

amgprec/amg_s_jac_solver.f90

@@ -101,7 +101,7 @@ module amg_s_jac_solver
 
   interface 
     subroutine amg_s_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
       implicit none 
@@ -111,6 +111,7 @@ module amg_s_jac_solver
       type(psb_s_vect_type),intent(inout)         :: y
       real(psb_spk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      real(psb_spk_),target, intent(inout)         :: work(:)
       type(psb_s_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_s_krm_solver.f90

@@ -131,7 +131,7 @@ module amg_s_krm_solver
 
   interface
     subroutine amg_s_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_s_krm_solver_type, psb_s_vect_type, psb_spk_, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
       implicit none
@@ -141,6 +141,7 @@ module amg_s_krm_solver
       type(psb_s_vect_type),intent(inout)         :: y
       real(psb_spk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      real(psb_spk_),target, intent(inout)         :: work(:)
       type(psb_s_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_s_mumps_solver.F90

@@ -117,7 +117,7 @@ module amg_s_mumps_solver
 
   interface 
     subroutine s_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_s_mumps_solver_type, psb_s_vect_type, psb_dpk_, psb_spk_, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
       implicit none 
@@ -127,6 +127,7 @@ module amg_s_mumps_solver
       type(psb_s_vect_type),intent(inout)  :: y
       real(psb_spk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)           :: trans
+      real(psb_spk_),target, intent(inout) :: work(:)
       type(psb_s_vect_type),intent(inout) :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_s_onelev_mod.f90

@@ -155,13 +155,35 @@ module amg_s_onelev_mod
   private :: s_wrk_alloc, s_wrk_free, &
        & s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv, s_wrk_sizeof
 
+  !
+  ! Remap.
+  !  This keeps track of remapping.
+  !  Logic here is as follows:
+  !  1. AC_PRE_REMAP  need to figure out if we
+  !                really need it.
+  !  2. DESC_AC_PRE_REMAP  contains the descriptor before
+  !                remapping. Meaning that it is possible
+  !                to implement the RESTRICTOR operator by
+  !                 a. Doing LINMAP_U2V onto this one
+  !                 b. For each process, send the data to
+  !                    IDEST.
+  !                This assumes that remapping goes by
+  !                a factor of 2.
+  !                For the PROLONGATOR operators, we first
+  !                use DESC_AC, then split and send onto
+  !                the processes in DESC_AC_PRE_REMAP.
+  !
+  ! To be fixed: what happens if NP the starting processes
+  ! is not an even number? Coordinate with _X_remap in PSBLAS
+  ! 
   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
+    procedure, pass(rmp) :: clone      => s_remap_data_clone
+    procedure, pass(rmp) :: move_alloc => s_remap_move_alloc
   end type amg_s_remap_data_type
 
   type amg_s_onelev_type
@@ -207,7 +229,7 @@ module amg_s_onelev_mod
     procedure, pass(lv) :: get_wrksz => s_base_onelev_get_wrksize
     procedure, pass(lv) :: allocate_wrk   => s_base_onelev_allocate_wrk
     procedure, pass(lv) :: free_wrk       => s_base_onelev_free_wrk
-    procedure, nopass   :: stringval => amg_stringval
+    procedure, nopass   :: stringval  => amg_stringval
     procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc
 
 
@@ -231,9 +253,7 @@ module amg_s_onelev_mod
        & s_base_onelev_free_wrk
 
   interface
-    subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
-      import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lsspmat_type, psb_lpk_
-      import :: amg_s_onelev_type
+    module subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
       implicit none
       class(amg_s_onelev_type), intent(inout), target :: lv
       type(psb_sspmat_type), intent(in) :: a
@@ -245,10 +265,7 @@ module amg_s_onelev_mod
   end interface
 
   interface
-    subroutine amg_s_base_onelev_build(lv,info,amold,vmold,imold,ilv)
-      import :: psb_s_base_sparse_mat, psb_s_base_vect_type, &
-           & psb_i_base_vect_type, psb_spk_, amg_s_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_s_base_onelev_build(lv,info,amold,vmold,imold,ilv)
       implicit none
       class(amg_s_onelev_type), target, intent(inout) :: lv
       integer(psb_ipk_), intent(out) :: info
@@ -260,10 +277,7 @@ module amg_s_onelev_mod
   end interface
 
   interface
-    subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
       Implicit None
       ! Arguments
       class(amg_s_onelev_type), intent(in)    :: lv
@@ -276,10 +290,8 @@ module amg_s_onelev_mod
   end interface
 
   interface
-    subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,&
+         & iout,verbosity, prefix,global) 
       Implicit None
       ! Arguments
       class(amg_s_onelev_type), intent(in)    :: lv
@@ -293,10 +305,7 @@ module amg_s_onelev_mod
   end interface
 
   interface
-    subroutine amg_s_base_onelev_cnv(lv,info,amold,vmold,imold)
-      import :: amg_s_onelev_type, psb_s_base_vect_type, psb_spk_, &
-           & psb_s_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
-      ! Arguments
+    module subroutine amg_s_base_onelev_cnv(lv,info,amold,vmold,imold)
       class(amg_s_onelev_type), intent(inout)            :: lv
       integer(psb_ipk_), intent(out)                     :: info
       class(psb_s_base_sparse_mat), intent(in), optional :: amold
@@ -306,48 +315,32 @@ module amg_s_onelev_mod
   end interface
 
   interface
-    subroutine amg_s_base_onelev_free(lv,info)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_s_base_onelev_free(lv,info)
       implicit none
-
       class(amg_s_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_s_base_onelev_free
   end interface
 
   interface
-    subroutine amg_s_base_onelev_free_smoothers(lv,info)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_s_base_onelev_free_smoothers(lv,info)
       implicit none
-
       class(amg_s_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_s_base_onelev_free_smoothers
   end interface
 
   interface
-    subroutine amg_s_base_onelev_check(lv,info)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_s_base_onelev_check(lv,info)
       Implicit None
-      ! Arguments
       class(amg_s_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)            :: info
     end subroutine amg_s_base_onelev_check
   end interface
 
   interface
-    subroutine amg_s_base_onelev_setsm(lv,val,info,pos)
-      import :: psb_spk_, amg_s_onelev_type, amg_s_base_smoother_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_s_base_onelev_setsm(lv,val,info,pos)
       Implicit None
-
-      ! Arguments
       class(amg_s_onelev_type), target, intent(inout) :: lv
       class(amg_s_base_smoother_type), intent(in)     :: val
       integer(psb_ipk_), intent(out)                  :: info
@@ -356,12 +349,8 @@ module amg_s_onelev_mod
   end interface
 
   interface
-    subroutine amg_s_base_onelev_setsv(lv,val,info,pos)
-      import :: psb_spk_, amg_s_onelev_type, amg_s_base_solver_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_s_base_onelev_setsv(lv,val,info,pos)
       Implicit None
-
-      ! Arguments
       class(amg_s_onelev_type), target, intent(inout) :: lv
       class(amg_s_base_solver_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
@@ -370,12 +359,8 @@ module amg_s_onelev_mod
   end interface
 
   interface
-    subroutine amg_s_base_onelev_setag(lv,val,info,pos)
-      import :: psb_spk_, amg_s_onelev_type, amg_s_base_aggregator_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_s_base_onelev_setag(lv,val,info,pos)
       Implicit None
-
-      ! Arguments
       class(amg_s_onelev_type), target, intent(inout) :: lv
       class(amg_s_base_aggregator_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
@@ -384,13 +369,8 @@ module amg_s_onelev_mod
   end interface
 
   interface
-    subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
-      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
+    module subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
       Implicit None
-
-      ! Arguments
       class(amg_s_onelev_type), intent(inout) :: lv
       character(len=*), intent(in)              :: what
       integer(psb_ipk_), intent(in)             :: val
@@ -401,12 +381,8 @@ module amg_s_onelev_mod
   end interface
 
   interface
-    subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
-      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
+    module 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
       character(len=*), intent(in)              :: val
@@ -417,12 +393,8 @@ module amg_s_onelev_mod
   end interface
 
   interface
-    subroutine amg_s_base_onelev_csetr(lv,what,val,info,pos,idx)
-      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
+    module subroutine amg_s_base_onelev_csetr(lv,what,val,info,pos,idx)
       Implicit None
-
       class(amg_s_onelev_type), intent(inout) :: lv
       character(len=*), intent(in)              :: what
       real(psb_spk_), intent(in)                 :: val
@@ -433,11 +405,8 @@ module amg_s_onelev_mod
   end interface
 
   interface
-    subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
+    module subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
          & solver,tprol,global_num)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
       implicit none
       class(amg_s_onelev_type), intent(in) :: lv
       integer(psb_ipk_), intent(in)          :: level
@@ -448,8 +417,7 @@ module amg_s_onelev_mod
   end interface
 
   interface
-    subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
-      import
+    module subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
       implicit none
       class(amg_s_onelev_type), target, intent(inout) :: lv
       real(psb_spk_), intent(in)     :: alpha, beta
@@ -458,20 +426,20 @@ module amg_s_onelev_mod
       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,vtx,vty)
-      import
+    module subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
+         & work,vtx,vty)
       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
+    module subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
       implicit none
       class(amg_s_onelev_type), target, intent(inout) :: lv
       real(psb_spk_), intent(in)     :: alpha, beta
@@ -481,17 +449,130 @@ module amg_s_onelev_mod
       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,vtx,vty)
-      import
+    module subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,&
+         & work,vtx,vty)
       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
 
+  interface 
+    module subroutine s_base_onelev_move_alloc(lv, b,info)
+      implicit none
+      class(amg_s_onelev_type), target, intent(inout) :: lv, b
+      integer(psb_ipk_), intent(out) :: info
+    end subroutine s_base_onelev_move_alloc
+  end interface
+
+  interface 
+    module subroutine s_base_onelev_allocate_wrk(lv,info,vmold)
+      implicit none
+      class(amg_s_onelev_type), target, intent(inout) :: lv
+      integer(psb_ipk_), intent(out) :: info
+      class(psb_s_base_vect_type), intent(in), optional  :: vmold
+    end subroutine s_base_onelev_allocate_wrk
+  end interface
+  
+  interface 
+    module subroutine s_base_onelev_free_wrk(lv,info)
+      implicit none
+      class(amg_s_onelev_type), target, intent(inout) :: lv
+      integer(psb_ipk_), intent(out) :: info
+    end subroutine s_base_onelev_free_wrk
+  end interface
+
+  interface 
+    module  subroutine s_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
+      Implicit None
+      ! Arguments
+      class(amg_smlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(in)                     :: nwv
+      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
+    end subroutine s_wrk_alloc
+  end interface
+
+  interface 
+    module subroutine s_inner_do_wrk_alloc(wk,nwv,desc,vmold)
+      class(amg_smlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(in)                     :: nwv
+      type(psb_desc_type), intent(in)                   :: desc
+      class(psb_s_base_vect_type), intent(in), optional  :: vmold
+    end subroutine s_inner_do_wrk_alloc
+  end interface
+
+  interface 
+    module  subroutine s_wrk_free(wk,info)
+      Implicit None
+      ! Arguments
+      class(amg_smlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(out)                    :: info
+    end subroutine s_wrk_free
+  end interface
+
+  interface 
+    module  subroutine s_wrk_clone(wk,wkout,info)
+      Implicit None
+      ! Arguments
+      class(amg_smlprec_wrk_type), target, intent(inout) :: wk
+      class(amg_smlprec_wrk_type), target, intent(inout) :: wkout
+      integer(psb_ipk_), intent(out)                    :: info
+    end subroutine s_wrk_clone
+  end interface
+
+  interface 
+    module subroutine s_wrk_move_alloc(wk, b,info)
+      implicit none
+      class(amg_smlprec_wrk_type), target, intent(inout) :: wk, b
+      integer(psb_ipk_), intent(out) :: info
+    end subroutine s_wrk_move_alloc
+  end interface
+
+  interface
+    module subroutine s_wrk_cnv(wk,info,vmold)
+      Implicit None
+      class(amg_smlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(out)                    :: info
+      class(psb_s_base_vect_type), intent(in), optional  :: vmold
+    end subroutine s_wrk_cnv
+  end interface
+
+  interface
+    module function s_wrk_sizeof(wk) result(val)
+      implicit none
+      class(amg_smlprec_wrk_type), intent(in) :: wk
+      integer(psb_epk_) :: val
+    end  function s_wrk_sizeof
+  end interface
+
+  interface 
+    module subroutine s_remap_data_clone(rmp, remap_out, info)
+      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
+    end subroutine s_remap_data_clone
+  end interface
+
+  interface 
+    module subroutine s_remap_move_alloc(rmp, remap_out, info)
+      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
+    end subroutine s_remap_move_alloc
+  end interface
+  
+
 contains
   !
   ! Function returning the size of the amg_prec_type data structure
@@ -617,7 +698,7 @@ contains
     ! Arguments
     class(amg_s_onelev_type), target, intent(inout) :: lv
     class(amg_s_onelev_type), target, intent(inout) :: lvout
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                  :: info
 
     info = psb_success_
     if (allocated(lv%sm)) then
@@ -659,36 +740,6 @@ contains
 
   end subroutine s_base_onelev_clone
 
-  subroutine s_base_onelev_move_alloc(lv, b,info)
-    use psb_base_mod
-    implicit none
-    class(amg_s_onelev_type), target, intent(inout) :: lv, b
-    integer(psb_ipk_), intent(out) :: info
-
-    call b%free(info)
-    b%parms  = lv%parms
-    b%szratio = lv%szratio
-    if (associated(lv%sm2,lv%sm2a)) then
-      call move_alloc(lv%sm,b%sm)
-      call move_alloc(lv%sm2a,b%sm2a)
-      b%sm2 =>b%sm2a
-    else
-      call move_alloc(lv%sm,b%sm)
-      call move_alloc(lv%sm2a,b%sm2a)
-      b%sm2 =>b%sm
-    end if
-
-    call move_alloc(lv%aggr,b%aggr)
-    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%linmap,b%linmap,info)
-    b%base_a    => lv%base_a
-    b%base_desc => lv%base_desc
-
-  end subroutine s_base_onelev_move_alloc
-
-
   function s_base_onelev_get_wrksize(lv) result(val)
     implicit none
     class(amg_s_onelev_type), intent(inout) :: lv
@@ -726,269 +777,5 @@ contains
 
   end function s_base_onelev_get_wrksize
 
-  subroutine s_base_onelev_allocate_wrk(lv,info,vmold)
-    use psb_base_mod
-    implicit none
-    class(amg_s_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
-    class(psb_s_base_vect_type), intent(in), optional  :: vmold
-    !
-    integer(psb_ipk_) :: nwv, i
-    info = psb_success_
-    nwv = lv%get_wrksz()
-    if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
-    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
-
-
-  subroutine s_base_onelev_free_wrk(lv,info)
-    use psb_base_mod
-    implicit none
-    class(amg_s_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
-    !
-    integer(psb_ipk_) :: nwv,i
-    info = psb_success_
-
-    if (allocated(lv%wrk)) then
-      call lv%wrk%free(info)
-      if (info == 0) deallocate(lv%wrk,stat=info)
-    end if
-  end subroutine s_base_onelev_free_wrk
-
-  subroutine s_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
-    use psb_base_mod
-
-    Implicit None
-
-    ! Arguments
-    class(amg_smlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(in)                     :: nwv
-    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)
-    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)
-      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)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_smlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
-    !
-    integer(psb_ipk_) :: i
-    info = psb_success_
-
-    if (allocated(wk%tx)) deallocate(wk%tx, stat=info)
-    if (allocated(wk%ty)) deallocate(wk%ty, stat=info)
-    if (allocated(wk%x2l)) deallocate(wk%x2l, stat=info)
-    if (allocated(wk%y2l)) deallocate(wk%y2l, stat=info)
-    call wk%vtx%free(info)
-    call wk%vty%free(info)
-    call wk%vx2l%free(info)
-    call wk%vy2l%free(info)
-    if (allocated(wk%wv)) then
-      do i=1,size(wk%wv)
-        call wk%wv(i)%free(info)
-      end do
-      deallocate(wk%wv, stat=info)
-    end if
-
-  end subroutine s_wrk_free
-
-  subroutine s_wrk_clone(wk,wkout,info)
-    use psb_base_mod
-    Implicit None
-
-    ! Arguments
-    class(amg_smlprec_wrk_type), target, intent(inout) :: wk
-    class(amg_smlprec_wrk_type), target, intent(inout) :: wkout
-    integer(psb_ipk_), intent(out)                    :: info
-    !
-    integer(psb_ipk_) :: i
-    info = psb_success_
-
-    call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
-    call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
-    call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
-    call psb_safe_ab_cpy(wk%y2l,wkout%y2l,info)
-    call wk%vtx%clone(wkout%vtx,info)
-    call wk%vty%clone(wkout%vty,info)
-    call wk%vx2l%clone(wkout%vx2l,info)
-    call wk%vy2l%clone(wkout%vy2l,info)
-    if (allocated(wkout%wv)) then
-      do i=1,size(wkout%wv)
-        call wkout%wv(i)%free(info)
-      end do
-      deallocate( wkout%wv)
-    end if
-    allocate(wkout%wv(size(wk%wv)),stat=info)
-    do i=1,size(wk%wv)
-      call wk%wv(i)%clone(wkout%wv(i),info)
-    end do
-    return
-
-  end subroutine s_wrk_clone
-
-  subroutine s_wrk_move_alloc(wk, b,info)
-    implicit none
-    class(amg_smlprec_wrk_type), target, intent(inout) :: wk, b
-    integer(psb_ipk_), intent(out) :: info
-
-    call b%free(info)
-    call move_alloc(wk%tx,b%tx)
-    call move_alloc(wk%ty,b%ty)
-    call move_alloc(wk%x2l,b%x2l)
-    call move_alloc(wk%y2l,b%y2l)
-    !
-    ! Should define V%move_alloc....
-    call move_alloc(wk%vtx%v,b%vtx%v)
-    call move_alloc(wk%vty%v,b%vty%v)
-    call move_alloc(wk%vx2l%v,b%vx2l%v)
-    call move_alloc(wk%vy2l%v,b%vy2l%v)
-    call move_alloc(wk%wv,b%wv)
-
-  end subroutine s_wrk_move_alloc
-
-  subroutine s_wrk_cnv(wk,info,vmold)
-    use psb_base_mod
-
-    Implicit None
-
-    ! Arguments
-    class(amg_smlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
-    class(psb_s_base_vect_type), intent(in), optional  :: vmold
-    !
-    integer(psb_ipk_) :: i
-
-    info = psb_success_
-    if (present(vmold)) then
-      call wk%vtx%cnv(vmold)
-      call wk%vty%cnv(vmold)
-      call wk%vx2l%cnv(vmold)
-      call wk%vy2l%cnv(vmold)
-      if (allocated(wk%wv)) then
-        do i=1,size(wk%wv)
-          call wk%wv(i)%cnv(vmold)
-        end do
-      end if
-    end if
-  end subroutine s_wrk_cnv
-
-  function s_wrk_sizeof(wk) result(val)
-    use psb_realloc_mod
-    implicit none
-    class(amg_smlprec_wrk_type), intent(in) :: wk
-    integer(psb_epk_) :: val
-    integer :: i
-    val = 0
-    val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%tx)
-    val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%ty)
-    val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%x2l)
-    val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%y2l)
-    val = val + wk%vtx%sizeof()
-    val = val + wk%vty%sizeof()
-    val = val + wk%vx2l%sizeof()
-    val = val + wk%vy2l%sizeof()
-    if (allocated(wk%wv)) then
-      do i=1, size(wk%wv)
-        val = val + wk%wv(i)%sizeof()
-      end do
-    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_parmatch_aggregator_mod.F90

@@ -136,7 +136,7 @@ module amg_s_parmatch_aggregator_mod
     procedure, pass(ag) :: mat_bld      => amg_s_parmatch_aggregator_mat_bld
     procedure, pass(ag) :: mat_asb      => amg_s_parmatch_aggregator_mat_asb
     procedure, pass(ag) :: inner_mat_asb      => amg_s_parmatch_aggregator_inner_mat_asb
-    procedure, pass(ag) :: bld_map      => amg_s_parmatch_aggregator_bld_map
+    procedure, pass(ag) :: bld_linmap   => amg_s_parmatch_aggregator_bld_linmap
     procedure, pass(ag) :: csetc        => amg_s_parmatch_aggr_csetc
     procedure, pass(ag) :: cseti        => amg_s_parmatch_aggr_cseti
     procedure, pass(ag) :: default      => amg_s_parmatch_aggr_set_default
@@ -643,7 +643,7 @@ contains
     end select
   end subroutine amg_s_parmatch_aggregator_clone
 
-  subroutine  amg_s_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
+  subroutine  amg_s_parmatch_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
        & op_restr,op_prol,map,info)
     use psb_base_mod
     implicit none
@@ -654,7 +654,7 @@ contains
     type(psb_slinmap_type), intent(out)     :: map
     integer(psb_ipk_), intent(out)          :: info
     integer(psb_ipk_) :: err_act
-    character(len=20) :: name='s_parmatch_aggregator_bld_map'
+    character(len=20) :: name='s_parmatch_aggregator_bld_linmap'
 
     info = psb_success_
     call psb_erractionsave(err_act)
@@ -680,5 +680,5 @@ contains
 9999 call psb_error_handler(err_act)
 
     return
-  end subroutine amg_s_parmatch_aggregator_bld_map
+  end subroutine amg_s_parmatch_aggregator_bld_linmap
 end module amg_s_parmatch_aggregator_mod

amgprec/amg_s_poly_smoother.f90

@@ -94,7 +94,7 @@ module amg_s_poly_smoother
 
   interface
     subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
-         & sweeps,wv,info,init,initu)
+         & sweeps,work,wv,info,init,initu)
       import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
            & psb_ipk_
@@ -106,6 +106,7 @@ module amg_s_poly_smoother
       real(psb_spk_),intent(in)                      :: alpha,beta
       character(len=1),intent(in)                     :: trans
       integer(psb_ipk_), intent(in)                   :: sweeps
+      real(psb_spk_),target, intent(inout)           :: work(:)
       type(psb_s_vect_type),intent(inout)           :: wv(:)
       integer(psb_ipk_), intent(out)                  :: info
       character, intent(in), optional                :: init

amgprec/amg_s_prec_type.f90

@@ -102,6 +102,7 @@ module amg_s_prec_type
     ! The multilevel hierarchy
     !
     type(amg_s_onelev_type), allocatable :: precv(:)
+    integer(psb_ipk_)                    :: nlevs
   contains
     procedure, pass(prec)               :: psb_s_apply2_vect => amg_s_apply2_vect
     procedure, pass(prec)               :: psb_s_apply1_vect => amg_s_apply1_vect
@@ -119,6 +120,7 @@ module amg_s_prec_type
     procedure, pass(prec)               :: cmp_complexity => amg_s_cmp_compl
     procedure, pass(prec)               :: get_avg_cr => amg_s_get_avg_cr
     procedure, pass(prec)               :: cmp_avg_cr => amg_s_cmp_avg_cr
+    procedure, pass(prec)               :: set_nlevs  => amg_s_set_nlevs
     procedure, pass(prec)               :: get_nlevs  => amg_s_get_nlevs
     procedure, pass(prec)               :: get_nzeros => amg_s_get_nzeros
     procedure, pass(prec)               :: sizeof => amg_sprec_sizeof
@@ -193,7 +195,7 @@ module amg_s_prec_type
   end interface
 
   interface amg_precapply
-    subroutine amg_sprecaply2_vect(prec,x,y,desc_data,info,trans)
+    subroutine amg_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
       import :: psb_sspmat_type, psb_desc_type, &
            & psb_spk_, psb_s_vect_type, amg_sprec_type, psb_ipk_
       type(psb_desc_type),intent(in)      :: desc_data
@@ -202,8 +204,9 @@ module amg_s_prec_type
       type(psb_s_vect_type),intent(inout) :: y
       integer(psb_ipk_), intent(out)                :: info
       character(len=1), optional          :: trans
+      real(psb_spk_),intent(inout), optional, target :: work(:)
     end subroutine amg_sprecaply2_vect
-    subroutine amg_sprecaply1_vect(prec,x,desc_data,info,trans)
+    subroutine amg_sprecaply1_vect(prec,x,desc_data,info,trans,work)
       import :: psb_sspmat_type, psb_desc_type, &
            & psb_spk_, psb_s_vect_type, amg_sprec_type, psb_ipk_
       type(psb_desc_type),intent(in)      :: desc_data
@@ -211,6 +214,7 @@ module amg_s_prec_type
       type(psb_s_vect_type),intent(inout) :: x
       integer(psb_ipk_), intent(out)                :: info
       character(len=1), optional          :: trans
+      real(psb_spk_),intent(inout), optional, target :: work(:)
     end subroutine amg_sprecaply1_vect
     subroutine amg_sprecaply(prec,x,y,desc_data,info,trans,work)
       import :: psb_sspmat_type, psb_desc_type, psb_spk_, amg_sprec_type, psb_ipk_
@@ -433,10 +437,19 @@ contains
     class(amg_sprec_type), intent(in) :: prec
     integer(psb_ipk_) :: val
     val = 0
-    if (allocated(prec%precv)) then
-      val = size(prec%precv)
-    end if
+!!$    if (allocated(prec%precv)) then
+!!$      val = size(prec%precv)
+!!$    end if
+    val = prec%nlevs
+!!$    write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
   end function amg_s_get_nlevs
+
+  subroutine amg_s_set_nlevs(prec,nl) 
+    implicit none
+    class(amg_sprec_type), intent(inout) :: prec
+    integer(psb_ipk_) :: nl
+    prec%nlevs = nl
+  end subroutine amg_s_set_nlevs
   !
   ! Function returning the size of the amg_prec_type data structure
   ! in bytes or in number of nonzeros of the operator(s) involved.
@@ -507,7 +520,7 @@ contains
 
     real(psb_spk_) :: num, den, nmin
     type(psb_ctxt_type) :: ctxt
-    integer(psb_ipk_)   :: il
+    integer(psb_ipk_)   :: il,nl
 
     num = -sone
     den = sone
@@ -517,7 +530,10 @@ contains
       num = prec%precv(il)%base_a%get_nzeros()
       if (num >= szero) then
         den = num
-        do il=2,size(prec%precv)
+        nl = prec%get_nlevs()
+!!$        write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
+        do il=2, nl
+!!$          write(0,*) '                 ',il,associated(prec%precv(il)%base_a)
           num = num + max(0,prec%precv(il)%base_a%get_nzeros())
         end do
       end if
@@ -548,7 +564,6 @@ contains
   end function amg_s_get_avg_cr
 
   subroutine amg_s_cmp_avg_cr(prec)
-
     implicit none
     class(amg_sprec_type), intent(inout) :: prec
 
@@ -556,17 +571,18 @@ contains
     type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_)   :: il, nl, iam, np
 
-
     avgcr = szero
+    nl = prec%get_nlevs()
+    do il=2,nl
+      if (prec%precv(il)%base_desc%is_ok()) then 
+        ctxt = prec%precv(il)%base_desc%get_ctxt()
+        call psb_info(ctxt,iam,np)
+        if (iam >=0)  avgcr = avgcr + max(szero,prec%precv(il)%szratio)
+      end if
+    end do
+    avgcr = avgcr / (nl-1)
     ctxt = prec%ctxt
     call psb_info(ctxt,iam,np)
-    if (allocated(prec%precv)) then
-      nl = size(prec%precv)
-      do il=2,nl
-        avgcr = avgcr + max(szero,prec%precv(il)%szratio)
-      end do
-      avgcr = avgcr / (nl-1)
-    end if
     call psb_sum(ctxt,avgcr)
     prec%ag_data%avg_cr = avgcr/np
   end subroutine amg_s_cmp_avg_cr
@@ -584,9 +600,7 @@ contains
   !             error code.
   !
   subroutine amg_sprecfree(p,info)
-
     implicit none
-
     ! Arguments
     type(amg_sprec_type), intent(inout) :: p
     integer(psb_ipk_), intent(out)        :: info
@@ -612,9 +626,7 @@ contains
   end subroutine amg_sprecfree
 
   subroutine amg_s_prec_free(prec,info)
-
     implicit none
-
     ! Arguments
     class(amg_sprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -651,9 +663,7 @@ contains
   end subroutine amg_s_prec_free
 
   subroutine amg_s_smoothers_free(prec,info)
-
     implicit none
-
     ! Arguments
     class(amg_sprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -670,7 +680,7 @@ contains
     end if
 
     if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
+      do i=1,prec%get_nlevs()
         call prec%precv(i)%free_smoothers(info)
       end do
     end if
@@ -684,9 +694,7 @@ contains
   end subroutine amg_s_smoothers_free
 
   subroutine amg_s_hierarchy_free(prec,info)
-
     implicit none
-
     ! Arguments
     class(amg_sprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -713,11 +721,10 @@ contains
 
   end subroutine amg_s_hierarchy_free
 
-
   !
   ! Top level methods.
   !
-  subroutine amg_s_apply2_vect(prec,x,y,desc_data,info,trans)
+  subroutine amg_s_apply2_vect(prec,x,y,desc_data,info,trans,work)
     implicit none
     type(psb_desc_type),intent(in)        :: desc_data
     class(amg_sprec_type), intent(inout)  :: prec
@@ -725,6 +732,7 @@ contains
     type(psb_s_vect_type),intent(inout)   :: y
     integer(psb_ipk_), intent(out)          :: info
     character(len=1), optional              :: trans
+    real(psb_spk_),intent(inout), optional, target :: work(:)
     Integer(psb_ipk_) :: err_act
     character(len=20) :: name='d_prec_apply'
 
@@ -732,7 +740,7 @@ contains
 
     select type(prec)
     type is (amg_sprec_type)
-      call amg_precapply(prec,x,y,desc_data,info,trans)
+      call amg_precapply(prec,x,y,desc_data,info,trans,work)
     class default
       info = psb_err_missing_override_method_
       call psb_errpush(info,name)
@@ -747,13 +755,14 @@ contains
 
   end subroutine amg_s_apply2_vect
 
-  subroutine amg_s_apply1_vect(prec,x,desc_data,info,trans)
+  subroutine amg_s_apply1_vect(prec,x,desc_data,info,trans,work)
     implicit none
     type(psb_desc_type),intent(in)          :: desc_data
     class(amg_sprec_type), intent(inout)  :: prec
     type(psb_s_vect_type),intent(inout)   :: x
     integer(psb_ipk_), intent(out)          :: info
     character(len=1), optional            :: trans
+    real(psb_spk_),intent(inout), optional, target :: work(:)
     Integer(psb_ipk_) :: err_act
     character(len=20) :: name='d_prec_apply'
 
@@ -761,7 +770,7 @@ contains
 
     select type(prec)
     type is (amg_sprec_type)
-      call amg_precapply(prec,x,desc_data,info,trans)
+      call amg_precapply(prec,x,desc_data,info,trans,work)
     class default
       info = psb_err_missing_override_method_
       call psb_errpush(info,name)
@@ -776,7 +785,6 @@ contains
 
   end subroutine amg_s_apply1_vect
 
-
   subroutine amg_s_apply2v(prec,x,y,desc_data,info,trans,work)
     implicit none
     type(psb_desc_type),intent(in)    :: desc_data
@@ -841,7 +849,6 @@ contains
   subroutine amg_s_dump(prec,info,istart,iend,iproc,prefix,head,&
        & ac,rp,smoother,solver,tprol,&
        & global_num)
-
     implicit none
     class(amg_sprec_type), intent(in)     :: prec
     integer(psb_ipk_), intent(out)          :: info
@@ -858,7 +865,7 @@ contains
     info = 0
     ctxt = prec%ctxt
     call psb_info(ctxt,iam,np)
-    iln = size(prec%precv)
+    iln = prec%get_nlevs()
     if (present(istart)) then
       il1 = max(1,istart)
     else
@@ -882,7 +889,6 @@ contains
   end subroutine amg_s_dump
 
   subroutine amg_s_cnv(prec,info,amold,vmold,imold)
-
     implicit none
     class(amg_sprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)       :: info
@@ -894,7 +900,7 @@ contains
 
     info = psb_success_
     if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
+      do i=1,prec%get_nlevs()
         if (info == psb_success_ ) &
              & call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
       end do
@@ -903,7 +909,6 @@ contains
   end subroutine amg_s_cnv
 
   subroutine amg_s_clone(prec,precout,info)
-
     implicit none
     class(amg_sprec_type), intent(inout) :: prec
     class(psb_sprec_type), intent(inout) :: precout
@@ -915,7 +920,6 @@ contains
   end subroutine amg_s_clone
 
   subroutine amg_s_inner_clone(prec,precout,info)
-
     implicit none
     class(amg_sprec_type), intent(inout)         :: prec
     class(psb_sprec_type), target, intent(inout) :: precout
@@ -931,8 +935,9 @@ contains
       pout%ctxt          = prec%ctxt
       pout%ag_data       = prec%ag_data
       pout%outer_sweeps  = prec%outer_sweeps
+      pout%nlevs         = prec%nlevs
       if (allocated(prec%precv)) then
-        ln = size(prec%precv)
+        ln = prec%get_nlevs()
         allocate(pout%precv(ln),stat=info)
         if (info /= psb_success_) goto 9999
         if (ln >= 1) then
@@ -940,6 +945,7 @@ contains
         end if
         do lev=2, ln
           if (info /= psb_success_) exit
+!!$          write(0,*) 'Inner_clone must be checked and reimplemented! '
           call prec%precv(lev)%clone(pout%precv(lev),info)
           if (info == psb_success_) then
             pout%precv(lev)%base_a       => pout%precv(lev)%ac
@@ -1019,7 +1025,7 @@ contains
     if (psb_errstatus_fatal()) then
       info = psb_err_internal_error_; goto 9999
     end if
-    nlev   = size(prec%precv)
+    nlev   = prec%get_nlevs()
     level = 1
     do level = 1, nlev
       call prec%precv(level)%allocate_wrk(info,vmold=vmold)
@@ -1042,7 +1048,6 @@ contains
   subroutine amg_s_free_wrk(prec,info)
     use psb_base_mod
     implicit none
-
     ! Arguments
     class(amg_sprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -1059,7 +1064,7 @@ contains
     end if
 
     if (allocated(prec%precv)) then
-      nlev   = size(prec%precv)
+      nlev   = prec%get_nlevs()
       do level = 1, nlev
         call prec%precv(level)%free_wrk(info)
       end do

amgprec/amg_s_slu_solver.F90

@@ -137,7 +137,7 @@ module amg_s_slu_solver
 
   interface
     subroutine amg_s_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       use psb_base_mod
       import amg_s_slu_solver_type
       implicit none 
@@ -147,6 +147,7 @@ module amg_s_slu_solver
       type(psb_s_vect_type),intent(inout)  :: y
       real(psb_spk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)           :: trans
+      real(psb_spk_),target, intent(inout) :: work(:)
       type(psb_s_vect_type),intent(inout) :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_s_sludist_solver.F90

@@ -1,493 +0,0 @@
-!  
-!   
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior written permission.
-!   
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
-!
-! File: amg_s_sludist_solver_mod.f90
-!
-! Module: amg_s_sludist_solver_mod
-!
-!  This module defines: 
-!  - the amg_s_sludist_solver_type data structure containing the ingredients
-!    to interface with the SuperLU_Dist package. 
-!    1. The factorization is distributed (and thus exact)
-!
-!
-!
-module amg_s_sludist_solver
-
-  use iso_c_binding
-  use amg_s_base_solver_mod
-
-#if (!defined(AMG_HAVE_SLUDIST)) || defined(PSB_IPK8) 
-
-  type, extends(amg_s_base_solver_type) :: amg_s_sludist_solver_type
-
-  end type amg_s_sludist_solver_type
-#else
-  type, extends(amg_s_base_solver_type) :: amg_s_sludist_solver_type
-    type(c_ptr)                 :: lufactors=c_null_ptr
-    integer(c_long_long)        :: symbsize=0, numsize=0
-  contains
-    procedure, pass(sv) :: build   => s_sludist_solver_bld
-    procedure, pass(sv) :: apply_a => s_sludist_solver_apply
-    procedure, pass(sv) :: apply_v => s_sludist_solver_apply_vect
-    procedure, pass(sv) :: free    => s_sludist_solver_free
-    procedure, pass(sv) :: clear_data  => s_sludist_solver_clear_data
-    procedure, pass(sv) :: descr   => s_sludist_solver_descr
-    procedure, pass(sv) :: sizeof  => s_sludist_solver_sizeof
-    procedure, nopass   :: get_fmt => s_sludist_solver_get_fmt
-    procedure, nopass   :: get_id  => s_sludist_solver_get_id
-    procedure, pass(sv) :: is_global => s_sludist_solver_is_global
-    final               :: s_sludist_solver_finalize
-  end type amg_s_sludist_solver_type
-
-
-  private :: s_sludist_solver_bld, s_sludist_solver_apply, &
-       &  s_sludist_solver_free,   s_sludist_solver_descr, &
-       &  s_sludist_solver_sizeof, s_sludist_solver_apply_vect, &
-       &  s_sludist_solver_get_fmt,  s_sludist_solver_get_id, &
-       &  s_sludist_solver_is_global, s_sludist_solver_clear_data
-  private :: s_sludist_solver_finalize
-
-
-  interface 
-    function amg_ssludist_fact(n,nl,nnz,ifrst, &
-         & values,rowptr,colind,lufactors,npr,npc) &
-         & bind(c,name='amg_ssludist_fact') result(info)
-      use iso_c_binding
-      integer(c_int), value :: n,nl,nnz,ifrst,npr,npc
-      integer(c_int)        :: info
-      integer(c_int)        :: rowptr(*),colind(*)
-      real(c_float)     :: values(*)
-      type(c_ptr)           :: lufactors
-    end function amg_ssludist_fact
-  end interface
-
-  interface 
-    function amg_ssludist_solve(itrans,n,nrhs, b, ldb, lufactors)&
-         & bind(c,name='amg_ssludist_solve') result(info)
-      use iso_c_binding
-      integer(c_int)        :: info
-      integer(c_int), value :: itrans,n,nrhs,ldb
-      real(c_float)     :: b(ldb,*)
-      type(c_ptr), value    :: lufactors
-    end function amg_ssludist_solve
-  end interface
-
-  interface 
-    function amg_ssludist_free(lufactors)&
-         & bind(c,name='amg_ssludist_free') result(info)
-      use iso_c_binding
-      integer(c_int)        :: info
-      type(c_ptr), value    :: lufactors
-    end function amg_ssludist_free
-  end interface
-
-contains
-
-  subroutine s_sludist_solver_apply(alpha,sv,x,beta,y,desc_data,&
-       & trans,work,info,init,initu)
-    use psb_base_mod
-    implicit none 
-    type(psb_desc_type), intent(in)      :: desc_data
-    class(amg_s_sludist_solver_type), intent(inout) :: sv
-    real(psb_spk_),intent(inout)         :: x(:)
-    real(psb_spk_),intent(inout)         :: y(:)
-    real(psb_spk_),intent(in)            :: alpha,beta
-    character(len=1),intent(in)          :: trans
-    real(psb_spk_),target, intent(inout) :: work(:)
-    integer, intent(out)                 :: info
-    character, intent(in), optional       :: init
-    real(psb_spk_),intent(inout), optional :: initu(:)
-
-    integer    :: n_row,n_col
-    real(psb_spk_), pointer :: ww(:)
-    type(psb_ctxt_type) :: ctxt
-    integer             :: np,me,i, err_act
-    character           :: trans_
-    character(len=20)   :: name='s_sludist_solver_apply'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-
-    trans_ = psb_toupper(trans)
-    select case(trans_)
-    case('N')
-    case('T','C')
-    case default
-      call psb_errpush(psb_err_iarg_invalid_i_,name)
-      goto 9999
-    end select
-    !
-    ! For non-iterative solvers, init and initu are ignored.
-    !
-    
-
-    n_row = desc_data%get_local_rows()
-    n_col = desc_data%get_local_cols()
-
-    if (n_col <= size(work)) then 
-      ww => work(1:n_col)
-    else
-      allocate(ww(n_col),stat=info)
-      if (info /= psb_success_) then 
-        info=psb_err_alloc_request_
-        call psb_errpush(info,name,i_err=(/n_col/),&
-             & a_err='real(psb_spk_)')
-        goto 9999      
-      end if
-    endif
-
-    if (info == psb_success_)&
-         & call psb_geaxpby(sone,x,szero,ww,desc_data,info)
-
-    select case(trans_)
-    case('N')
-      info = amg_ssludist_solve(0,n_row,1,ww,n_row,sv%lufactors)
-    case('T')
-      info = amg_ssludist_solve(1,n_row,1,ww,n_row,sv%lufactors)
-    case('C')
-      info = amg_ssludist_solve(2,n_row,1,ww,n_row,sv%lufactors)
-    case default
-      call psb_errpush(psb_err_internal_error_,&
-           & name,a_err='Invalid TRANS in subsolve')
-      goto 9999
-    end select
-
-    if (info == psb_success_)&
-         & call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
-
-
-    if (info /= psb_success_) then
-      call psb_errpush(psb_err_internal_error_,&
-           & name,a_err='Error in subsolve')
-      goto 9999
-    endif
-
-    if (n_col > size(work)) then 
-      deallocate(ww)
-    endif
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine s_sludist_solver_apply
-
-  subroutine s_sludist_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-       & trans,wv,info,init,initu)
-    use psb_base_mod
-    implicit none
-    type(psb_desc_type), intent(in)      :: desc_data
-    class(amg_s_sludist_solver_type), intent(inout) :: sv
-    type(psb_s_vect_type),intent(inout)  :: x
-    type(psb_s_vect_type),intent(inout)  :: y
-    real(psb_spk_),intent(in)            :: alpha,beta
-    character(len=1),intent(in)           :: trans
-    type(psb_s_vect_type),intent(inout) :: wv(:)
-    integer, intent(out)                  :: info
-    character, intent(in), optional                :: init
-    type(psb_s_vect_type),intent(inout), optional   :: initu
-
-    real(psb_spk_), target :: aux(0)
-    integer    :: err_act
-    character(len=20)  :: name='s_sludist_solver_apply_vect'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    !
-    ! For non-iterative solvers, init and initu are ignored.
-    !
-    
-
-    call x%v%sync()
-    call y%v%sync()
-    call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,aux,info)
-    call y%v%set_host()
-    if (info /= 0) goto 9999
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine s_sludist_solver_apply_vect
-
-  subroutine s_sludist_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-
-    use psb_base_mod
-
-    Implicit None
-
-    ! Arguments
-    type(psb_sspmat_type), intent(inout), target        :: a
-    Type(psb_desc_type), Intent(inout)                  :: desc_a 
-    class(amg_s_sludist_solver_type), intent(inout)     :: sv
-    integer, intent(out)                                :: info
-    type(psb_sspmat_type), intent(in), target, optional :: b
-    class(psb_s_base_sparse_mat), intent(in), optional  :: amold
-    class(psb_s_base_vect_type), intent(in), optional   :: vmold
-    class(psb_i_base_vect_type), intent(in), optional  :: imold
-    ! Local variables
-    type(psb_sspmat_type) :: atmp
-    type(psb_s_csr_sparse_mat) :: acsr
-    type(psb_ctxt_type) :: ctxt
-    integer(psb_lpk_), allocatable :: gia(:), gja(:)
-    integer(psb_lpk_) :: lfrst
-    integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
-    integer(psb_ipk_) :: ifrst, ibcheck
-    integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
-    character(len=20)  :: name='s_sludist_solver_bld', ch_err
-    
-    info=psb_success_
-    call psb_erractionsave(err_act)
-    debug_unit  = psb_get_debug_unit()
-    debug_level = psb_get_debug_level()
-    ctxt       = desc_a%get_context()
-    call psb_info(ctxt, me, np)
-    npr  = np
-    npc  = 1
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),' start'
-
-
-    
-    n_row  = desc_a%get_local_rows()
-    n_col  = desc_a%get_local_cols()
-    nglob  = desc_a%get_global_rows()
-    
-    !
-    ! Strategy here is as follows: because a call to SLUDIST
-    ! as a gobal solver is mostly done  at the coarsest level,
-    ! even if we start from a problem requiring 8 bytes, chances
-    ! are that the global size will be suitable for 4 bytes
-    ! anyway, so we hope for the best, and throw an error
-    ! if something goes wrong.
-    !
-    if (nglob > huge(1_psb_ipk_)) then
-      write(0,*) me,' ',trim(name),': Error: overflow of local indices '
-      info=psb_err_internal_error_
-      call psb_errpush(info,name)
-      goto 9999
-    end if
-    
-    call a%cscnv(atmp,info,type='csr')
-    ! This in case we are dealing with AS
-    call psb_rwextd(n_row,atmp,info,b=b) 
-    call atmp%mv_to(acsr)
-    nrow_a = acsr%get_nrows()
-    nztota = acsr%get_nzeros()
-    call psb_loc_to_glob(ione,lfrst,desc_a,info)
-    
-    ! Fix the entries to call C-base SuperLU
-    call psb_realloc(nztota,gja,info)
-    call psb_loc_to_glob(acsr%ja(1:nztota),gja(1:nztota), desc_a, info, iact='I')
-    acsr%ja(1:nztota) = gja(1:nztota)
-    acsr%ja(:)  = acsr%ja(:)  - 1
-    acsr%irp(:) = acsr%irp(:) - 1
-    ifrst = lfrst - 1
-    info = amg_ssludist_fact(nglob,nrow_a,nztota,ifrst,&
-         & acsr%val,acsr%irp,acsr%ja,sv%lufactors,&
-         & npr,npc)
-    
-    if (info /= psb_success_) then
-      info=psb_err_from_subroutine_
-      ch_err='amg_ssludist_fact'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-    end if
-    
-    call acsr%free()
-
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),' end'
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_sludist_solver_bld
-
-  subroutine s_sludist_solver_free(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_sludist_solver_type), intent(inout) :: sv
-    integer, intent(out)                       :: info
-    Integer :: err_act
-    character(len=20)  :: name='s_sludist_solver_free'
-
-    call psb_erractionsave(err_act)
-    info = 0
-    call sv%clear_data(info)
-    
-    if (info /= psb_success_) goto 9999
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_sludist_solver_free
-
-  subroutine s_sludist_solver_clear_data(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_sludist_solver_type), intent(inout) :: sv
-    integer, intent(out)                       :: info
-    Integer :: err_act
-    character(len=20)  :: name='s_sludist_solver_clear_data'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_ 
-    if (c_associated(sv%lufactors)) info = amg_ssludist_free(sv%lufactors)
-    sv%lufactors = c_null_ptr
-    
-    if (info /= psb_success_) goto 9999
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_sludist_solver_clear_data
-
-  ! 
-  function s_sludist_solver_is_global(sv) result(val)
-    implicit none 
-    class(amg_s_sludist_solver_type), intent(in) :: sv
-    logical  :: val
-
-    val = .true.
-  end function s_sludist_solver_is_global
-  
-  subroutine s_sludist_solver_finalize(sv)
-
-    Implicit None
-
-    ! Arguments
-    type(amg_s_sludist_solver_type), intent(inout) :: sv
-    integer :: info
-    Integer :: err_act
-    character(len=20)  :: name='s_sludist_solver_finalize'
-
-    call sv%free(info) 
-
-    return
-  
-  end subroutine s_sludist_solver_finalize
-
-  subroutine s_sludist_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_sludist_solver_type), intent(in) :: sv
-    integer, intent(out)                           :: info
-    integer, intent(in), optional                  :: iout
-    logical, intent(in), optional                  :: coarse
-    character(len=*), intent(in), optional         :: prefix
-
-    ! Local variables
-    integer      :: err_act
-    type(psb_ctxt_type) :: ctxt
-    integer      :: me, np
-    character(len=20), parameter :: name='amg_s_sludist_solver_descr'
-    integer :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-    
-    write(iout_,*) trim(prefix_), '  SuperLU_Dist Sparse Factorization Solver. '
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_sludist_solver_descr
-
-  function s_sludist_solver_sizeof(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_s_sludist_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer             :: i
-
-    val = 2*psb_sizeof_ip + psb_sizeof_dp
-    val = val + sv%symbsize
-    val = val + sv%numsize
-    return
-  end function s_sludist_solver_sizeof
-
-  function s_sludist_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "SuperLU_Dist solver"
-  end function s_sludist_solver_get_fmt
-
-  function s_sludist_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_sludist_
-  end function s_sludist_solver_get_id
-#endif
-end module amg_s_sludist_solver

amgprec/amg_s_umf_solver.F90

@@ -1,315 +0,0 @@
-!  
-!   
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!    
-!    (C) Copyright 2021 
-!  
-!        Salvatore Filippone  
-!        Pasqua D'Ambra   
-!        Fabio Durastante        
-!   
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior written permission.
-!   
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
-!
-! File: amg_s_umf_solver_mod.f90
-!
-! Module: amg_s_umf_solver_mod
-!
-!  This module defines: 
-!  - the amg_s_umf_solver_type data structure containing the ingredients
-!    to interface with the UMFPACK package. 
-!    1. The factorization is restricted to the diagonal block of the
-!       current image.
-!
-module amg_s_umf_solver
-
-  use iso_c_binding
-  use amg_s_base_solver_mod
-
-#if defined(PSB_IPK8)
-  type, extends(amg_s_base_solver_type) :: amg_s_umf_solver_type
-
-  end type amg_s_umf_solver_type
-
-#else
-  
-  type, extends(amg_s_base_solver_type) :: amg_s_umf_solver_type
-    type(c_ptr)                 :: symbolic=c_null_ptr, numeric=c_null_ptr
-    integer(c_long_long)        :: symbsize=0, numsize=0
-  contains
-    procedure, pass(sv) :: build   => amg_s_umf_solver_bld
-    procedure, pass(sv) :: apply_a => amg_s_umf_solver_apply
-    procedure, pass(sv) :: apply_v => amg_s_umf_solver_apply_vect
-    procedure, pass(sv) :: free    => s_umf_solver_free
-    procedure, pass(sv) :: clear_data  => s_umf_solver_clear_data
-    procedure, pass(sv) :: descr   => s_umf_solver_descr
-    procedure, pass(sv) :: sizeof  => s_umf_solver_sizeof
-    procedure, nopass   :: get_fmt => s_umf_solver_get_fmt
-    procedure, nopass   :: get_id  => s_umf_solver_get_id
-    final               :: s_umf_solver_finalize
-  end type amg_s_umf_solver_type
-
-
-  private :: s_umf_solver_free,   s_umf_solver_descr, &
-       &  s_umf_solver_sizeof, &
-       &  s_umf_solver_get_fmt, s_umf_solver_get_id, &
-       &  s_umf_solver_clear_data
-  private :: s_umf_solver_finalize
-
-
-
-  interface 
-    function amg_sumf_fact(n,nnz,values,rowind,colptr,&
-         & symptr,numptr,ssize,nsize)&
-         & bind(c,name='amg_sumf_fact') result(info)
-      use iso_c_binding
-      integer(c_int), value :: n,nnz
-      integer(c_int)        :: info
-      integer(c_long_long)  :: ssize, nsize
-      integer(c_int)        :: rowind(*),colptr(*)
-      real(c_float)  :: values(*)
-      type(c_ptr)           :: symptr, numptr
-    end function amg_sumf_fact
-  end interface
-
-  interface 
-    function amg_sumf_solve(itrans,n,x, b, ldb, numptr)&
-         & bind(c,name='amg_sumf_solve') result(info)
-      use iso_c_binding
-      integer(c_int)        :: info
-      integer(c_int), value :: itrans,n,ldb
-      real(c_float) :: x(*), b(ldb,*)
-      type(c_ptr), value    :: numptr
-    end function amg_sumf_solve
-  end interface
-
-  interface 
-    function amg_sumf_free(symptr, numptr)&
-         & bind(c,name='amg_sumf_free') result(info)
-      use iso_c_binding
-      integer(c_int)        :: info
-      type(c_ptr), value    :: symptr, numptr
-    end function amg_sumf_free
-  end interface
-
-  interface
-    subroutine amg_s_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
-         & trans,work,info,init,initu)
-      use psb_base_mod
-      import amg_s_umf_solver_type
-      implicit none 
-      type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_s_umf_solver_type), intent(inout) :: sv
-      real(psb_spk_),intent(inout)         :: x(:)
-      real(psb_spk_),intent(inout)         :: y(:)
-      real(psb_spk_),intent(in)            :: alpha,beta
-      character(len=1),intent(in)          :: trans
-      real(psb_spk_),target, intent(inout) :: work(:)
-      integer(psb_ipk_), intent(out)        :: info
-      character, intent(in), optional       :: init
-      real(psb_spk_),intent(inout), optional :: initu(:)
-    end subroutine amg_s_umf_solver_apply
-  end interface
-  
-  interface
-    subroutine amg_s_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
-      use psb_base_mod
-      import amg_s_umf_solver_type
-      implicit none 
-      type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_s_umf_solver_type), intent(inout) :: sv
-      type(psb_s_vect_type),intent(inout)  :: x
-      type(psb_s_vect_type),intent(inout)  :: y
-      real(psb_spk_),intent(in)            :: alpha,beta
-      character(len=1),intent(in)           :: trans
-      type(psb_s_vect_type),intent(inout) :: wv(:)
-      integer(psb_ipk_), intent(out)                 :: info
-      character, intent(in), optional                :: init
-      type(psb_s_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_s_umf_solver_apply_vect
-  end interface
-
-  interface 
-    subroutine amg_s_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      use psb_base_mod
-      import amg_s_umf_solver_type
-      Implicit None
-      
-      ! Arguments
-      type(psb_sspmat_type), intent(inout), target        :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_s_umf_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                        :: info
-      type(psb_sspmat_type), intent(in), target, optional :: b
-      class(psb_s_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_s_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional  :: imold
-    end subroutine amg_s_umf_solver_bld
-  end interface
-
-contains
-
-
-  subroutine s_umf_solver_free(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_umf_solver_type), intent(inout) :: sv
-    integer, intent(out)                       :: info
-    Integer :: err_act
-    character(len=20)  :: name='s_umf_solver_free'
-
-    call psb_erractionsave(err_act)
-
-    call sv%clear_data(info) 
-    
-    if (info /= psb_success_) goto 9999
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_umf_solver_free
-
-
-  subroutine s_umf_solver_clear_data(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_umf_solver_type), intent(inout) :: sv
-    integer, intent(out)                       :: info
-    Integer :: err_act
-    character(len=20)  :: name='s_umf_solver_clear_data'
-
-    call psb_erractionsave(err_act)
-    info = 0 
-    if (c_associated(sv%symbolic).and.c_associated(sv%numeric)) then 
-      info = amg_sumf_free(sv%symbolic,sv%numeric)
-      
-      if (info /= psb_success_) goto 9999
-      sv%symbolic = c_null_ptr
-      sv%numeric  = c_null_ptr
-      sv%symbsize = 0
-      sv%numsize  = 0
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_umf_solver_clear_data
-
-  subroutine s_umf_solver_finalize(sv)
-
-    Implicit None
-
-    ! Arguments
-    type(amg_s_umf_solver_type), intent(inout) :: sv
-    integer :: info
-    Integer :: err_act
-    character(len=20)  :: name='s_umf_solver_finalize'
-
-    call sv%free(info) 
-
-    return
-  
-  end subroutine s_umf_solver_finalize
-
-  subroutine s_umf_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_umf_solver_type), intent(in) :: sv
-    integer, intent(out)                       :: info
-    integer, intent(in), optional              :: iout
-    logical, intent(in), optional              :: coarse
-      character(len=*), intent(in), optional   :: prefix
-
-    ! Local variables
-    integer      :: err_act
-    character(len=20), parameter :: name='amg_s_umf_solver_descr'
-    integer :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-    
-    write(iout_,*) trim(prefix_), '  UMFPACK Sparse Factorization Solver. '
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_umf_solver_descr
-
-  function s_umf_solver_sizeof(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_s_umf_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer             :: i
-
-    val = 2*psb_sizeof_lp 
-    val = val + sv%symbsize
-    val = val + sv%numsize
-    return
-  end function s_umf_solver_sizeof
-
-  function s_umf_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "UMFPACK solver"
-  end function s_umf_solver_get_fmt
-
-  function s_umf_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_umf_
-  end function s_umf_solver_get_id
-#endif
-end module amg_s_umf_solver

amgprec/amg_z_as_smoother.f90

@@ -120,7 +120,7 @@ module amg_z_as_smoother
   end interface
   
   interface 
-    subroutine amg_z_as_smoother_restr_v(sm,x,trans,info,data)
+    subroutine amg_z_as_smoother_restr_v(sm,x,trans,work,info,data)
       import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
            & psb_dpk_, amg_z_as_smoother_type, psb_epk_, &
            & psb_desc_type, psb_ipk_
@@ -128,6 +128,7 @@ module amg_z_as_smoother
       class(amg_z_as_smoother_type), intent(inout) :: sm
       type(psb_z_vect_type),intent(inout)          :: x
       character(len=1),intent(in)                    :: trans
+      complex(psb_dpk_),target, intent(inout)          :: work(:)
       integer(psb_ipk_), intent(out)                 :: info
       integer(psb_ipk_), optional, intent(in)        :: data
     end subroutine amg_z_as_smoother_restr_v
@@ -149,7 +150,7 @@ module amg_z_as_smoother
   end interface
 
   interface 
-    subroutine amg_z_as_smoother_prol_v(sm,x,trans,info,data)
+    subroutine amg_z_as_smoother_prol_v(sm,x,trans,work,info,data)
       import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
            & psb_dpk_, amg_z_as_smoother_type, psb_epk_, &
            & psb_desc_type, psb_ipk_
@@ -157,6 +158,7 @@ module amg_z_as_smoother
       class(amg_z_as_smoother_type), intent(inout) :: sm
       type(psb_z_vect_type),intent(inout)          :: x
       character(len=1),intent(in)                    :: trans
+      complex(psb_dpk_),target, intent(inout)          :: work(:)
       integer(psb_ipk_), intent(out)                 :: info
       integer(psb_ipk_), optional, intent(in)        :: data
     end subroutine amg_z_as_smoother_prol_v
@@ -180,7 +182,7 @@ module amg_z_as_smoother
   
   interface 
     subroutine amg_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
-      & trans,sweeps,wv,info,init,initu)
+      & trans,sweeps,work,wv,info,init,initu)
       import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
            & psb_dpk_, amg_z_as_smoother_type, psb_epk_, &
            & psb_desc_type, psb_ipk_
@@ -192,6 +194,7 @@ module amg_z_as_smoother
       complex(psb_dpk_),intent(in)                     :: alpha,beta
       character(len=1),intent(in)                    :: trans
       integer(psb_ipk_), intent(in)                  :: sweeps
+      complex(psb_dpk_),target, intent(inout)          :: work(:)
       type(psb_z_vect_type),intent(inout)          :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_z_base_aggregator_mod.f90

@@ -89,7 +89,7 @@ module amg_z_base_aggregator_mod
     procedure, pass(ag) :: bld_tprol   => amg_z_base_aggregator_build_tprol
     procedure, pass(ag) :: mat_bld     => amg_z_base_aggregator_mat_bld
     procedure, pass(ag) :: mat_asb     => amg_z_base_aggregator_mat_asb
-    procedure, pass(ag) :: bld_map     => amg_z_base_aggregator_bld_map
+    procedure, pass(ag) :: bld_linmap  => amg_z_base_aggregator_bld_linmap
     procedure, pass(ag) :: update_next => amg_z_base_aggregator_update_next
     procedure, pass(ag) :: clone       => amg_z_base_aggregator_clone
     procedure, pass(ag) :: free        => amg_z_base_aggregator_free
@@ -458,7 +458,7 @@ contains
   end subroutine amg_z_base_aggregator_mat_asb
 
   !
-  !> Function   bld_map
+  !> Function   bld_linmap
   !! \memberof  amg_z_base_aggregator_type
   !! \brief     Build linear map between hierarchy levels 
   !!
@@ -473,7 +473,7 @@ contains
   !!  \param map       The output map
   !!  \param info    Return code
   !!  
-  subroutine  amg_z_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
+  subroutine  amg_z_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
        & op_restr,op_prol,map,info)
     use psb_base_mod
     implicit none
@@ -484,7 +484,7 @@ contains
     type(psb_zlinmap_type), intent(out)    :: map
     integer(psb_ipk_), intent(out)       :: info
     integer(psb_ipk_) :: err_act
-    character(len=20) :: name='z_base_aggregator_bld_map'
+    character(len=20) :: name='z_base_aggregator_bld_linmap'
 
     info = psb_success_
     call psb_erractionsave(err_act)
@@ -508,7 +508,6 @@ contains
 9999 call psb_error_handler(err_act)
 
     return
-  end subroutine amg_z_base_aggregator_bld_map
-
+  end subroutine amg_z_base_aggregator_bld_linmap
 
 end module amg_z_base_aggregator_mod

amgprec/amg_z_base_ainv_mod.f90

@@ -116,7 +116,7 @@ module amg_z_base_ainv_mod
 
   interface
     subroutine amg_z_base_ainv_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         &  trans,wv,info,init,initu)
+         &  trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_dpk_,amg_z_base_ainv_solver_type, psb_z_vect_type, psb_ipk_
       type(psb_desc_type), intent(in)      :: desc_data
       class(amg_z_base_ainv_solver_type), intent(inout) :: sv
@@ -124,6 +124,7 @@ module amg_z_base_ainv_mod
       type(psb_z_vect_type),intent(inout)  :: y
       complex(psb_dpk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)          :: trans
+      complex(psb_dpk_),target, intent(inout) :: work(:)
       type(psb_z_vect_type),intent(inout)  :: wv(:)
       integer(psb_ipk_), intent(out)       :: info
       character, intent(in), optional      :: init

amgprec/amg_z_base_smoother_mod.f90

@@ -160,7 +160,7 @@ module amg_z_base_smoother_mod
   
   interface 
     subroutine amg_z_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
-         &  trans,sweeps,wv,info,init,initu)
+         &  trans,sweeps,work,wv,info,init,initu)
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
            & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
            & amg_z_base_smoother_type, psb_ipk_
@@ -171,6 +171,7 @@ module amg_z_base_smoother_mod
       complex(psb_dpk_),intent(in)                       :: alpha,beta
       character(len=1),intent(in)                      :: trans
       integer(psb_ipk_), intent(in)                    :: sweeps
+      complex(psb_dpk_),target, intent(inout)            :: work(:)
       type(psb_z_vect_type),intent(inout)            :: wv(:)
       integer(psb_ipk_), intent(out)                   :: info
       character, intent(in), optional                :: init

amgprec/amg_z_base_solver_mod.f90

@@ -143,7 +143,7 @@ module amg_z_base_solver_mod
       
   interface 
     subroutine amg_z_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
            & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
            & amg_z_base_solver_type, psb_ipk_
@@ -154,6 +154,7 @@ module amg_z_base_solver_mod
       type(psb_z_vect_type),intent(inout)          :: y
       complex(psb_dpk_),intent(in)                     :: alpha,beta
       character(len=1),intent(in)                    :: trans
+      complex(psb_dpk_),target, intent(inout)          :: work(:)
       type(psb_z_vect_type),intent(inout)            :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_z_diag_solver.f90

@@ -77,7 +77,7 @@ module amg_z_diag_solver
 
   interface 
     subroutine amg_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& 
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
        & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
        & amg_z_diag_solver_type, psb_ipk_
@@ -87,6 +87,7 @@ module amg_z_diag_solver
       type(psb_z_vect_type), intent(inout)         :: y
       complex(psb_dpk_),intent(in)                     :: alpha,beta
       character(len=1),intent(in)                    :: trans
+      complex(psb_dpk_),target, intent(inout)          :: work(:)
       type(psb_z_vect_type),intent(inout)          :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_z_gs_solver.f90

@@ -106,7 +106,7 @@ module amg_z_gs_solver
 
   interface 
     subroutine amg_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_z_gs_solver_type, psb_z_vect_type, psb_dpk_, &
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
       implicit none 
@@ -116,13 +116,14 @@ module amg_z_gs_solver
       type(psb_z_vect_type),intent(inout)         :: y
       complex(psb_dpk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      complex(psb_dpk_),target, intent(inout)         :: work(:)
       type(psb_z_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init
       type(psb_z_vect_type),intent(inout), optional   :: initu
     end subroutine amg_z_gs_solver_apply_vect
     subroutine amg_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_z_bwgs_solver_type, psb_z_vect_type, psb_dpk_, &
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
       implicit none 
@@ -132,6 +133,7 @@ module amg_z_gs_solver
       type(psb_z_vect_type),intent(inout)         :: y
       complex(psb_dpk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      complex(psb_dpk_),target, intent(inout)         :: work(:)
       type(psb_z_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_z_id_solver.f90

@@ -64,7 +64,7 @@ module amg_z_id_solver
 
   interface 
     subroutine amg_z_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
            & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & 
            & amg_z_id_solver_type, psb_ipk_
@@ -74,6 +74,7 @@ module amg_z_id_solver
       type(psb_z_vect_type),intent(inout)        :: y
       complex(psb_dpk_),intent(in)                   :: alpha,beta
       character(len=1),intent(in)                  :: trans
+      complex(psb_dpk_),target, intent(inout)        :: work(:)
       type(psb_z_vect_type),intent(inout)        :: wv(:)
       integer(psb_ipk_), intent(out)               :: info
       character, intent(in), optional                :: init

amgprec/amg_z_ilu_solver.f90

@@ -101,7 +101,7 @@ module amg_z_ilu_solver
 
   interface 
     subroutine amg_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_z_ilu_solver_type, psb_z_vect_type, psb_dpk_, &
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
       implicit none 
@@ -111,6 +111,7 @@ module amg_z_ilu_solver
       type(psb_z_vect_type),intent(inout)         :: y
       complex(psb_dpk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      complex(psb_dpk_),target, intent(inout)         :: work(:)
       type(psb_z_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_z_inner_mod.f90

@@ -67,7 +67,7 @@ module amg_z_inner_mod
   end interface amg_mlprec_bld
 
   interface amg_mlprec_aply
-    subroutine amg_zmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
+    subroutine amg_zmlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
       import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
       import :: amg_zprec_type
       implicit none 
@@ -79,18 +79,19 @@ module amg_z_inner_mod
       character,intent(in)               :: trans
       complex(psb_dpk_),target             :: work(:)
       integer(psb_ipk_), intent(out)     :: info
-    end subroutine amg_zmlprec_aply
-    subroutine amg_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,info)
+    end subroutine amg_zmlprec_aply_a
+    subroutine amg_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
       import :: psb_zspmat_type, psb_desc_type, &
            & psb_dpk_, psb_z_vect_type, psb_ipk_
       import :: amg_zprec_type
-      implicit none
+      implicit none 
       type(psb_desc_type),intent(in)        :: desc_data
       type(amg_zprec_type), intent(inout) :: p
       complex(psb_dpk_),intent(in)            :: alpha,beta
       type(psb_z_vect_type),intent(inout) :: x
       type(psb_z_vect_type),intent(inout) :: y
       character,intent(in)                  :: trans
+      complex(psb_dpk_),target                :: work(:)
       integer(psb_ipk_), intent(out)        :: info
     end subroutine amg_zmlprec_aply_vect
   end interface amg_mlprec_aply

amgprec/amg_z_jac_smoother.f90

@@ -106,7 +106,7 @@ module amg_z_jac_smoother
 
   interface
     subroutine amg_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
-         & sweeps,wv,info,init,initu)
+         & sweeps,work,wv,info,init,initu)
       import :: psb_desc_type, amg_z_jac_smoother_type, psb_z_vect_type, psb_dpk_, &
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
            & psb_ipk_
@@ -118,6 +118,7 @@ module amg_z_jac_smoother
       complex(psb_dpk_),intent(in)                      :: alpha,beta
       character(len=1),intent(in)                     :: trans
       integer(psb_ipk_), intent(in)                   :: sweeps
+      complex(psb_dpk_),target, intent(inout)           :: work(:)
       type(psb_z_vect_type),intent(inout)           :: wv(:)
       integer(psb_ipk_), intent(out)                  :: info
       character, intent(in), optional                :: init

amgprec/amg_z_jac_solver.f90

@@ -101,7 +101,7 @@ module amg_z_jac_solver
 
   interface 
     subroutine amg_z_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_z_jac_solver_type, psb_z_vect_type, psb_dpk_, &
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
       implicit none 
@@ -111,6 +111,7 @@ module amg_z_jac_solver
       type(psb_z_vect_type),intent(inout)         :: y
       complex(psb_dpk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      complex(psb_dpk_),target, intent(inout)         :: work(:)
       type(psb_z_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_z_krm_solver.f90

@@ -131,7 +131,7 @@ module amg_z_krm_solver
 
   interface
     subroutine amg_z_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_z_krm_solver_type, psb_z_vect_type, psb_dpk_, &
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
       implicit none
@@ -141,6 +141,7 @@ module amg_z_krm_solver
       type(psb_z_vect_type),intent(inout)         :: y
       complex(psb_dpk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
+      complex(psb_dpk_),target, intent(inout)         :: work(:)
       type(psb_z_vect_type),intent(inout)         :: wv(:)
       integer(psb_ipk_), intent(out)                :: info
       character, intent(in), optional                :: init

amgprec/amg_z_mumps_solver.F90

@@ -117,7 +117,7 @@ module amg_z_mumps_solver
 
   interface 
     subroutine z_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       import :: psb_desc_type, amg_z_mumps_solver_type, psb_z_vect_type, psb_dpk_, psb_spk_, &
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
       implicit none 
@@ -127,6 +127,7 @@ module amg_z_mumps_solver
       type(psb_z_vect_type),intent(inout)  :: y
       complex(psb_dpk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)           :: trans
+      complex(psb_dpk_),target, intent(inout) :: work(:)
       type(psb_z_vect_type),intent(inout) :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_z_onelev_mod.f90

@@ -154,13 +154,35 @@ module amg_z_onelev_mod
   private :: z_wrk_alloc, z_wrk_free, &
        & z_wrk_clone, z_wrk_move_alloc, z_wrk_cnv, z_wrk_sizeof
 
+  !
+  ! Remap.
+  !  This keeps track of remapping.
+  !  Logic here is as follows:
+  !  1. AC_PRE_REMAP  need to figure out if we
+  !                really need it.
+  !  2. DESC_AC_PRE_REMAP  contains the descriptor before
+  !                remapping. Meaning that it is possible
+  !                to implement the RESTRICTOR operator by
+  !                 a. Doing LINMAP_U2V onto this one
+  !                 b. For each process, send the data to
+  !                    IDEST.
+  !                This assumes that remapping goes by
+  !                a factor of 2.
+  !                For the PROLONGATOR operators, we first
+  !                use DESC_AC, then split and send onto
+  !                the processes in DESC_AC_PRE_REMAP.
+  !
+  ! To be fixed: what happens if NP the starting processes
+  ! is not an even number? Coordinate with _X_remap in PSBLAS
+  ! 
   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
+    procedure, pass(rmp) :: clone      => z_remap_data_clone
+    procedure, pass(rmp) :: move_alloc => z_remap_move_alloc
   end type amg_z_remap_data_type
 
   type amg_z_onelev_type
@@ -206,7 +228,7 @@ module amg_z_onelev_mod
     procedure, pass(lv) :: get_wrksz => z_base_onelev_get_wrksize
     procedure, pass(lv) :: allocate_wrk   => z_base_onelev_allocate_wrk
     procedure, pass(lv) :: free_wrk       => z_base_onelev_free_wrk
-    procedure, nopass   :: stringval => amg_stringval
+    procedure, nopass   :: stringval  => amg_stringval
     procedure, pass(lv) :: move_alloc => z_base_onelev_move_alloc
 
 
@@ -230,9 +252,7 @@ module amg_z_onelev_mod
        & z_base_onelev_free_wrk
 
   interface
-    subroutine amg_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
-      import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_, psb_lzspmat_type, psb_lpk_
-      import :: amg_z_onelev_type
+    module subroutine amg_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
       implicit none
       class(amg_z_onelev_type), intent(inout), target :: lv
       type(psb_zspmat_type), intent(in) :: a
@@ -244,10 +264,7 @@ module amg_z_onelev_mod
   end interface
 
   interface
-    subroutine amg_z_base_onelev_build(lv,info,amold,vmold,imold,ilv)
-      import :: psb_z_base_sparse_mat, psb_z_base_vect_type, &
-           & psb_i_base_vect_type, psb_dpk_, amg_z_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_z_base_onelev_build(lv,info,amold,vmold,imold,ilv)
       implicit none
       class(amg_z_onelev_type), target, intent(inout) :: lv
       integer(psb_ipk_), intent(out) :: info
@@ -259,10 +276,7 @@ module amg_z_onelev_mod
   end interface
 
   interface
-    subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
-      import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
-           & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
       Implicit None
       ! Arguments
       class(amg_z_onelev_type), intent(in)    :: lv
@@ -275,10 +289,8 @@ module amg_z_onelev_mod
   end interface
 
   interface
-    subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
-      import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
-           & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,&
+         & iout,verbosity, prefix,global) 
       Implicit None
       ! Arguments
       class(amg_z_onelev_type), intent(in)    :: lv
@@ -292,10 +304,7 @@ module amg_z_onelev_mod
   end interface
 
   interface
-    subroutine amg_z_base_onelev_cnv(lv,info,amold,vmold,imold)
-      import :: amg_z_onelev_type, psb_z_base_vect_type, psb_dpk_, &
-           & psb_z_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
-      ! Arguments
+    module subroutine amg_z_base_onelev_cnv(lv,info,amold,vmold,imold)
       class(amg_z_onelev_type), intent(inout)            :: lv
       integer(psb_ipk_), intent(out)                     :: info
       class(psb_z_base_sparse_mat), intent(in), optional :: amold
@@ -305,48 +314,32 @@ module amg_z_onelev_mod
   end interface
 
   interface
-    subroutine amg_z_base_onelev_free(lv,info)
-      import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
-           & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_z_base_onelev_free(lv,info)
       implicit none
-
       class(amg_z_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_z_base_onelev_free
   end interface
 
   interface
-    subroutine amg_z_base_onelev_free_smoothers(lv,info)
-      import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
-           & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_z_base_onelev_free_smoothers(lv,info)
       implicit none
-
       class(amg_z_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)                :: info
     end subroutine amg_z_base_onelev_free_smoothers
   end interface
 
   interface
-    subroutine amg_z_base_onelev_check(lv,info)
-      import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
-           & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_z_base_onelev_check(lv,info)
       Implicit None
-      ! Arguments
       class(amg_z_onelev_type), intent(inout) :: lv
       integer(psb_ipk_), intent(out)            :: info
     end subroutine amg_z_base_onelev_check
   end interface
 
   interface
-    subroutine amg_z_base_onelev_setsm(lv,val,info,pos)
-      import :: psb_dpk_, amg_z_onelev_type, amg_z_base_smoother_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_z_base_onelev_setsm(lv,val,info,pos)
       Implicit None
-
-      ! Arguments
       class(amg_z_onelev_type), target, intent(inout) :: lv
       class(amg_z_base_smoother_type), intent(in)     :: val
       integer(psb_ipk_), intent(out)                  :: info
@@ -355,12 +348,8 @@ module amg_z_onelev_mod
   end interface
 
   interface
-    subroutine amg_z_base_onelev_setsv(lv,val,info,pos)
-      import :: psb_dpk_, amg_z_onelev_type, amg_z_base_solver_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_z_base_onelev_setsv(lv,val,info,pos)
       Implicit None
-
-      ! Arguments
       class(amg_z_onelev_type), target, intent(inout) :: lv
       class(amg_z_base_solver_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
@@ -369,12 +358,8 @@ module amg_z_onelev_mod
   end interface
 
   interface
-    subroutine amg_z_base_onelev_setag(lv,val,info,pos)
-      import :: psb_dpk_, amg_z_onelev_type, amg_z_base_aggregator_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
+    module subroutine amg_z_base_onelev_setag(lv,val,info,pos)
       Implicit None
-
-      ! Arguments
       class(amg_z_onelev_type), target, intent(inout) :: lv
       class(amg_z_base_aggregator_type), intent(in)       :: val
       integer(psb_ipk_), intent(out)                  :: info
@@ -383,13 +368,8 @@ module amg_z_onelev_mod
   end interface
 
   interface
-    subroutine amg_z_base_onelev_cseti(lv,what,val,info,pos,idx)
-      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
+    module subroutine amg_z_base_onelev_cseti(lv,what,val,info,pos,idx)
       Implicit None
-
-      ! Arguments
       class(amg_z_onelev_type), intent(inout) :: lv
       character(len=*), intent(in)              :: what
       integer(psb_ipk_), intent(in)             :: val
@@ -400,12 +380,8 @@ module amg_z_onelev_mod
   end interface
 
   interface
-    subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
-      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
+    module 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
       character(len=*), intent(in)              :: val
@@ -416,12 +392,8 @@ module amg_z_onelev_mod
   end interface
 
   interface
-    subroutine amg_z_base_onelev_csetr(lv,what,val,info,pos,idx)
-      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
+    module subroutine amg_z_base_onelev_csetr(lv,what,val,info,pos,idx)
       Implicit None
-
       class(amg_z_onelev_type), intent(inout) :: lv
       character(len=*), intent(in)              :: what
       real(psb_dpk_), intent(in)                 :: val
@@ -432,11 +404,8 @@ module amg_z_onelev_mod
   end interface
 
   interface
-    subroutine amg_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
+    module subroutine amg_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
          & solver,tprol,global_num)
-      import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
-           & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
       implicit none
       class(amg_z_onelev_type), intent(in) :: lv
       integer(psb_ipk_), intent(in)          :: level
@@ -447,8 +416,7 @@ module amg_z_onelev_mod
   end interface
 
   interface
-    subroutine amg_z_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
-      import
+    module subroutine amg_z_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
       implicit none
       class(amg_z_onelev_type), target, intent(inout) :: lv
       complex(psb_dpk_), intent(in)     :: alpha, beta
@@ -457,20 +425,20 @@ module amg_z_onelev_mod
       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,vtx,vty)
-      import
+    module subroutine amg_z_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
+         & work,vtx,vty)
       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
+    module subroutine amg_z_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
       implicit none
       class(amg_z_onelev_type), target, intent(inout) :: lv
       complex(psb_dpk_), intent(in)     :: alpha, beta
@@ -480,17 +448,130 @@ module amg_z_onelev_mod
       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,vtx,vty)
-      import
+    module subroutine amg_z_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,&
+         & work,vtx,vty)
       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
 
+  interface 
+    module subroutine z_base_onelev_move_alloc(lv, b,info)
+      implicit none
+      class(amg_z_onelev_type), target, intent(inout) :: lv, b
+      integer(psb_ipk_), intent(out) :: info
+    end subroutine z_base_onelev_move_alloc
+  end interface
+
+  interface 
+    module subroutine z_base_onelev_allocate_wrk(lv,info,vmold)
+      implicit none
+      class(amg_z_onelev_type), target, intent(inout) :: lv
+      integer(psb_ipk_), intent(out) :: info
+      class(psb_z_base_vect_type), intent(in), optional  :: vmold
+    end subroutine z_base_onelev_allocate_wrk
+  end interface
+  
+  interface 
+    module subroutine z_base_onelev_free_wrk(lv,info)
+      implicit none
+      class(amg_z_onelev_type), target, intent(inout) :: lv
+      integer(psb_ipk_), intent(out) :: info
+    end subroutine z_base_onelev_free_wrk
+  end interface
+
+  interface 
+    module  subroutine z_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
+      Implicit None
+      ! Arguments
+      class(amg_zmlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(in)                     :: nwv
+      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
+    end subroutine z_wrk_alloc
+  end interface
+
+  interface 
+    module subroutine z_inner_do_wrk_alloc(wk,nwv,desc,vmold)
+      class(amg_zmlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(in)                     :: nwv
+      type(psb_desc_type), intent(in)                   :: desc
+      class(psb_z_base_vect_type), intent(in), optional  :: vmold
+    end subroutine z_inner_do_wrk_alloc
+  end interface
+
+  interface 
+    module  subroutine z_wrk_free(wk,info)
+      Implicit None
+      ! Arguments
+      class(amg_zmlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(out)                    :: info
+    end subroutine z_wrk_free
+  end interface
+
+  interface 
+    module  subroutine z_wrk_clone(wk,wkout,info)
+      Implicit None
+      ! Arguments
+      class(amg_zmlprec_wrk_type), target, intent(inout) :: wk
+      class(amg_zmlprec_wrk_type), target, intent(inout) :: wkout
+      integer(psb_ipk_), intent(out)                    :: info
+    end subroutine z_wrk_clone
+  end interface
+
+  interface 
+    module subroutine z_wrk_move_alloc(wk, b,info)
+      implicit none
+      class(amg_zmlprec_wrk_type), target, intent(inout) :: wk, b
+      integer(psb_ipk_), intent(out) :: info
+    end subroutine z_wrk_move_alloc
+  end interface
+
+  interface
+    module subroutine z_wrk_cnv(wk,info,vmold)
+      Implicit None
+      class(amg_zmlprec_wrk_type), target, intent(inout) :: wk
+      integer(psb_ipk_), intent(out)                    :: info
+      class(psb_z_base_vect_type), intent(in), optional  :: vmold
+    end subroutine z_wrk_cnv
+  end interface
+
+  interface
+    module function z_wrk_sizeof(wk) result(val)
+      implicit none
+      class(amg_zmlprec_wrk_type), intent(in) :: wk
+      integer(psb_epk_) :: val
+    end  function z_wrk_sizeof
+  end interface
+
+  interface 
+    module subroutine z_remap_data_clone(rmp, remap_out, info)
+      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
+    end subroutine z_remap_data_clone
+  end interface
+
+  interface 
+    module subroutine z_remap_move_alloc(rmp, remap_out, info)
+      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
+    end subroutine z_remap_move_alloc
+  end interface
+  
+
 contains
   !
   ! Function returning the size of the amg_prec_type data structure
@@ -616,7 +697,7 @@ contains
     ! Arguments
     class(amg_z_onelev_type), target, intent(inout) :: lv
     class(amg_z_onelev_type), target, intent(inout) :: lvout
-    integer(psb_ipk_), intent(out)                    :: info
+    integer(psb_ipk_), intent(out)                  :: info
 
     info = psb_success_
     if (allocated(lv%sm)) then
@@ -658,36 +739,6 @@ contains
 
   end subroutine z_base_onelev_clone
 
-  subroutine z_base_onelev_move_alloc(lv, b,info)
-    use psb_base_mod
-    implicit none
-    class(amg_z_onelev_type), target, intent(inout) :: lv, b
-    integer(psb_ipk_), intent(out) :: info
-
-    call b%free(info)
-    b%parms  = lv%parms
-    b%szratio = lv%szratio
-    if (associated(lv%sm2,lv%sm2a)) then
-      call move_alloc(lv%sm,b%sm)
-      call move_alloc(lv%sm2a,b%sm2a)
-      b%sm2 =>b%sm2a
-    else
-      call move_alloc(lv%sm,b%sm)
-      call move_alloc(lv%sm2a,b%sm2a)
-      b%sm2 =>b%sm
-    end if
-
-    call move_alloc(lv%aggr,b%aggr)
-    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%linmap,b%linmap,info)
-    b%base_a    => lv%base_a
-    b%base_desc => lv%base_desc
-
-  end subroutine z_base_onelev_move_alloc
-
-
   function z_base_onelev_get_wrksize(lv) result(val)
     implicit none
     class(amg_z_onelev_type), intent(inout) :: lv
@@ -725,269 +776,5 @@ contains
 
   end function z_base_onelev_get_wrksize
 
-  subroutine z_base_onelev_allocate_wrk(lv,info,vmold)
-    use psb_base_mod
-    implicit none
-    class(amg_z_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
-    class(psb_z_base_vect_type), intent(in), optional  :: vmold
-    !
-    integer(psb_ipk_) :: nwv, i
-    info = psb_success_
-    nwv = lv%get_wrksz()
-    if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
-    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
-
-
-  subroutine z_base_onelev_free_wrk(lv,info)
-    use psb_base_mod
-    implicit none
-    class(amg_z_onelev_type), target, intent(inout) :: lv
-    integer(psb_ipk_), intent(out) :: info
-    !
-    integer(psb_ipk_) :: nwv,i
-    info = psb_success_
-
-    if (allocated(lv%wrk)) then
-      call lv%wrk%free(info)
-      if (info == 0) deallocate(lv%wrk,stat=info)
-    end if
-  end subroutine z_base_onelev_free_wrk
-
-  subroutine z_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
-    use psb_base_mod
-
-    Implicit None
-
-    ! Arguments
-    class(amg_zmlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(in)                     :: nwv
-    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)
-    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)
-      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)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_zmlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
-    !
-    integer(psb_ipk_) :: i
-    info = psb_success_
-
-    if (allocated(wk%tx)) deallocate(wk%tx, stat=info)
-    if (allocated(wk%ty)) deallocate(wk%ty, stat=info)
-    if (allocated(wk%x2l)) deallocate(wk%x2l, stat=info)
-    if (allocated(wk%y2l)) deallocate(wk%y2l, stat=info)
-    call wk%vtx%free(info)
-    call wk%vty%free(info)
-    call wk%vx2l%free(info)
-    call wk%vy2l%free(info)
-    if (allocated(wk%wv)) then
-      do i=1,size(wk%wv)
-        call wk%wv(i)%free(info)
-      end do
-      deallocate(wk%wv, stat=info)
-    end if
-
-  end subroutine z_wrk_free
-
-  subroutine z_wrk_clone(wk,wkout,info)
-    use psb_base_mod
-    Implicit None
-
-    ! Arguments
-    class(amg_zmlprec_wrk_type), target, intent(inout) :: wk
-    class(amg_zmlprec_wrk_type), target, intent(inout) :: wkout
-    integer(psb_ipk_), intent(out)                    :: info
-    !
-    integer(psb_ipk_) :: i
-    info = psb_success_
-
-    call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
-    call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
-    call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
-    call psb_safe_ab_cpy(wk%y2l,wkout%y2l,info)
-    call wk%vtx%clone(wkout%vtx,info)
-    call wk%vty%clone(wkout%vty,info)
-    call wk%vx2l%clone(wkout%vx2l,info)
-    call wk%vy2l%clone(wkout%vy2l,info)
-    if (allocated(wkout%wv)) then
-      do i=1,size(wkout%wv)
-        call wkout%wv(i)%free(info)
-      end do
-      deallocate( wkout%wv)
-    end if
-    allocate(wkout%wv(size(wk%wv)),stat=info)
-    do i=1,size(wk%wv)
-      call wk%wv(i)%clone(wkout%wv(i),info)
-    end do
-    return
-
-  end subroutine z_wrk_clone
-
-  subroutine z_wrk_move_alloc(wk, b,info)
-    implicit none
-    class(amg_zmlprec_wrk_type), target, intent(inout) :: wk, b
-    integer(psb_ipk_), intent(out) :: info
-
-    call b%free(info)
-    call move_alloc(wk%tx,b%tx)
-    call move_alloc(wk%ty,b%ty)
-    call move_alloc(wk%x2l,b%x2l)
-    call move_alloc(wk%y2l,b%y2l)
-    !
-    ! Should define V%move_alloc....
-    call move_alloc(wk%vtx%v,b%vtx%v)
-    call move_alloc(wk%vty%v,b%vty%v)
-    call move_alloc(wk%vx2l%v,b%vx2l%v)
-    call move_alloc(wk%vy2l%v,b%vy2l%v)
-    call move_alloc(wk%wv,b%wv)
-
-  end subroutine z_wrk_move_alloc
-
-  subroutine z_wrk_cnv(wk,info,vmold)
-    use psb_base_mod
-
-    Implicit None
-
-    ! Arguments
-    class(amg_zmlprec_wrk_type), target, intent(inout) :: wk
-    integer(psb_ipk_), intent(out)                    :: info
-    class(psb_z_base_vect_type), intent(in), optional  :: vmold
-    !
-    integer(psb_ipk_) :: i
-
-    info = psb_success_
-    if (present(vmold)) then
-      call wk%vtx%cnv(vmold)
-      call wk%vty%cnv(vmold)
-      call wk%vx2l%cnv(vmold)
-      call wk%vy2l%cnv(vmold)
-      if (allocated(wk%wv)) then
-        do i=1,size(wk%wv)
-          call wk%wv(i)%cnv(vmold)
-        end do
-      end if
-    end if
-  end subroutine z_wrk_cnv
-
-  function z_wrk_sizeof(wk) result(val)
-    use psb_realloc_mod
-    implicit none
-    class(amg_zmlprec_wrk_type), intent(in) :: wk
-    integer(psb_epk_) :: val
-    integer :: i
-    val = 0
-    val = val + (1_psb_epk_ * (2*psb_sizeof_dp)) * psb_size(wk%tx)
-    val = val + (1_psb_epk_ * (2*psb_sizeof_dp)) * psb_size(wk%ty)
-    val = val + (1_psb_epk_ * (2*psb_sizeof_dp)) * psb_size(wk%x2l)
-    val = val + (1_psb_epk_ * (2*psb_sizeof_dp)) * psb_size(wk%y2l)
-    val = val + wk%vtx%sizeof()
-    val = val + wk%vty%sizeof()
-    val = val + wk%vx2l%sizeof()
-    val = val + wk%vy2l%sizeof()
-    if (allocated(wk%wv)) then
-      do i=1, size(wk%wv)
-        val = val + wk%wv(i)%sizeof()
-      end do
-    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_type.f90

@@ -102,6 +102,7 @@ module amg_z_prec_type
     ! The multilevel hierarchy
     !
     type(amg_z_onelev_type), allocatable :: precv(:)
+    integer(psb_ipk_)                    :: nlevs
   contains
     procedure, pass(prec)               :: psb_z_apply2_vect => amg_z_apply2_vect
     procedure, pass(prec)               :: psb_z_apply1_vect => amg_z_apply1_vect
@@ -119,6 +120,7 @@ module amg_z_prec_type
     procedure, pass(prec)               :: cmp_complexity => amg_z_cmp_compl
     procedure, pass(prec)               :: get_avg_cr => amg_z_get_avg_cr
     procedure, pass(prec)               :: cmp_avg_cr => amg_z_cmp_avg_cr
+    procedure, pass(prec)               :: set_nlevs  => amg_z_set_nlevs
     procedure, pass(prec)               :: get_nlevs  => amg_z_get_nlevs
     procedure, pass(prec)               :: get_nzeros => amg_z_get_nzeros
     procedure, pass(prec)               :: sizeof => amg_zprec_sizeof
@@ -193,7 +195,7 @@ module amg_z_prec_type
   end interface
 
   interface amg_precapply
-    subroutine amg_zprecaply2_vect(prec,x,y,desc_data,info,trans)
+    subroutine amg_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
       import :: psb_zspmat_type, psb_desc_type, &
            & psb_dpk_, psb_z_vect_type, amg_zprec_type, psb_ipk_
       type(psb_desc_type),intent(in)      :: desc_data
@@ -202,8 +204,9 @@ module amg_z_prec_type
       type(psb_z_vect_type),intent(inout) :: y
       integer(psb_ipk_), intent(out)                :: info
       character(len=1), optional          :: trans
+      complex(psb_dpk_),intent(inout), optional, target :: work(:)
     end subroutine amg_zprecaply2_vect
-    subroutine amg_zprecaply1_vect(prec,x,desc_data,info,trans)
+    subroutine amg_zprecaply1_vect(prec,x,desc_data,info,trans,work)
       import :: psb_zspmat_type, psb_desc_type, &
            & psb_dpk_, psb_z_vect_type, amg_zprec_type, psb_ipk_
       type(psb_desc_type),intent(in)      :: desc_data
@@ -211,6 +214,7 @@ module amg_z_prec_type
       type(psb_z_vect_type),intent(inout) :: x
       integer(psb_ipk_), intent(out)                :: info
       character(len=1), optional          :: trans
+      complex(psb_dpk_),intent(inout), optional, target :: work(:)
     end subroutine amg_zprecaply1_vect
     subroutine amg_zprecaply(prec,x,y,desc_data,info,trans,work)
       import :: psb_zspmat_type, psb_desc_type, psb_dpk_, amg_zprec_type, psb_ipk_
@@ -433,10 +437,19 @@ contains
     class(amg_zprec_type), intent(in) :: prec
     integer(psb_ipk_) :: val
     val = 0
-    if (allocated(prec%precv)) then
-      val = size(prec%precv)
-    end if
+!!$    if (allocated(prec%precv)) then
+!!$      val = size(prec%precv)
+!!$    end if
+    val = prec%nlevs
+!!$    write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
   end function amg_z_get_nlevs
+
+  subroutine amg_z_set_nlevs(prec,nl) 
+    implicit none
+    class(amg_zprec_type), intent(inout) :: prec
+    integer(psb_ipk_) :: nl
+    prec%nlevs = nl
+  end subroutine amg_z_set_nlevs
   !
   ! Function returning the size of the amg_prec_type data structure
   ! in bytes or in number of nonzeros of the operator(s) involved.
@@ -507,7 +520,7 @@ contains
 
     real(psb_dpk_) :: num, den, nmin
     type(psb_ctxt_type) :: ctxt
-    integer(psb_ipk_)   :: il
+    integer(psb_ipk_)   :: il,nl
 
     num = -done
     den = done
@@ -517,7 +530,10 @@ contains
       num = prec%precv(il)%base_a%get_nzeros()
       if (num >= dzero) then
         den = num
-        do il=2,size(prec%precv)
+        nl = prec%get_nlevs()
+!!$        write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
+        do il=2, nl
+!!$          write(0,*) '                 ',il,associated(prec%precv(il)%base_a)
           num = num + max(0,prec%precv(il)%base_a%get_nzeros())
         end do
       end if
@@ -548,7 +564,6 @@ contains
   end function amg_z_get_avg_cr
 
   subroutine amg_z_cmp_avg_cr(prec)
-
     implicit none
     class(amg_zprec_type), intent(inout) :: prec
 
@@ -556,17 +571,18 @@ contains
     type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_)   :: il, nl, iam, np
 
-
     avgcr = dzero
+    nl = prec%get_nlevs()
+    do il=2,nl
+      if (prec%precv(il)%base_desc%is_ok()) then 
+        ctxt = prec%precv(il)%base_desc%get_ctxt()
+        call psb_info(ctxt,iam,np)
+        if (iam >=0)  avgcr = avgcr + max(dzero,prec%precv(il)%szratio)
+      end if
+    end do
+    avgcr = avgcr / (nl-1)
     ctxt = prec%ctxt
     call psb_info(ctxt,iam,np)
-    if (allocated(prec%precv)) then
-      nl = size(prec%precv)
-      do il=2,nl
-        avgcr = avgcr + max(dzero,prec%precv(il)%szratio)
-      end do
-      avgcr = avgcr / (nl-1)
-    end if
     call psb_sum(ctxt,avgcr)
     prec%ag_data%avg_cr = avgcr/np
   end subroutine amg_z_cmp_avg_cr
@@ -584,9 +600,7 @@ contains
   !             error code.
   !
   subroutine amg_zprecfree(p,info)
-
     implicit none
-
     ! Arguments
     type(amg_zprec_type), intent(inout) :: p
     integer(psb_ipk_), intent(out)        :: info
@@ -612,9 +626,7 @@ contains
   end subroutine amg_zprecfree
 
   subroutine amg_z_prec_free(prec,info)
-
     implicit none
-
     ! Arguments
     class(amg_zprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -651,9 +663,7 @@ contains
   end subroutine amg_z_prec_free
 
   subroutine amg_z_smoothers_free(prec,info)
-
     implicit none
-
     ! Arguments
     class(amg_zprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -670,7 +680,7 @@ contains
     end if
 
     if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
+      do i=1,prec%get_nlevs()
         call prec%precv(i)%free_smoothers(info)
       end do
     end if
@@ -684,9 +694,7 @@ contains
   end subroutine amg_z_smoothers_free
 
   subroutine amg_z_hierarchy_free(prec,info)
-
     implicit none
-
     ! Arguments
     class(amg_zprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -713,11 +721,10 @@ contains
 
   end subroutine amg_z_hierarchy_free
 
-
   !
   ! Top level methods.
   !
-  subroutine amg_z_apply2_vect(prec,x,y,desc_data,info,trans)
+  subroutine amg_z_apply2_vect(prec,x,y,desc_data,info,trans,work)
     implicit none
     type(psb_desc_type),intent(in)        :: desc_data
     class(amg_zprec_type), intent(inout)  :: prec
@@ -725,6 +732,7 @@ contains
     type(psb_z_vect_type),intent(inout)   :: y
     integer(psb_ipk_), intent(out)          :: info
     character(len=1), optional              :: trans
+    complex(psb_dpk_),intent(inout), optional, target :: work(:)
     Integer(psb_ipk_) :: err_act
     character(len=20) :: name='d_prec_apply'
 
@@ -732,7 +740,7 @@ contains
 
     select type(prec)
     type is (amg_zprec_type)
-      call amg_precapply(prec,x,y,desc_data,info,trans)
+      call amg_precapply(prec,x,y,desc_data,info,trans,work)
     class default
       info = psb_err_missing_override_method_
       call psb_errpush(info,name)
@@ -747,13 +755,14 @@ contains
 
   end subroutine amg_z_apply2_vect
 
-  subroutine amg_z_apply1_vect(prec,x,desc_data,info,trans)
+  subroutine amg_z_apply1_vect(prec,x,desc_data,info,trans,work)
     implicit none
     type(psb_desc_type),intent(in)          :: desc_data
     class(amg_zprec_type), intent(inout)  :: prec
     type(psb_z_vect_type),intent(inout)   :: x
     integer(psb_ipk_), intent(out)          :: info
     character(len=1), optional            :: trans
+    complex(psb_dpk_),intent(inout), optional, target :: work(:)
     Integer(psb_ipk_) :: err_act
     character(len=20) :: name='d_prec_apply'
 
@@ -761,7 +770,7 @@ contains
 
     select type(prec)
     type is (amg_zprec_type)
-      call amg_precapply(prec,x,desc_data,info,trans)
+      call amg_precapply(prec,x,desc_data,info,trans,work)
     class default
       info = psb_err_missing_override_method_
       call psb_errpush(info,name)
@@ -776,7 +785,6 @@ contains
 
   end subroutine amg_z_apply1_vect
 
-
   subroutine amg_z_apply2v(prec,x,y,desc_data,info,trans,work)
     implicit none
     type(psb_desc_type),intent(in)    :: desc_data
@@ -841,7 +849,6 @@ contains
   subroutine amg_z_dump(prec,info,istart,iend,iproc,prefix,head,&
        & ac,rp,smoother,solver,tprol,&
        & global_num)
-
     implicit none
     class(amg_zprec_type), intent(in)     :: prec
     integer(psb_ipk_), intent(out)          :: info
@@ -858,7 +865,7 @@ contains
     info = 0
     ctxt = prec%ctxt
     call psb_info(ctxt,iam,np)
-    iln = size(prec%precv)
+    iln = prec%get_nlevs()
     if (present(istart)) then
       il1 = max(1,istart)
     else
@@ -882,7 +889,6 @@ contains
   end subroutine amg_z_dump
 
   subroutine amg_z_cnv(prec,info,amold,vmold,imold)
-
     implicit none
     class(amg_zprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)       :: info
@@ -894,7 +900,7 @@ contains
 
     info = psb_success_
     if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
+      do i=1,prec%get_nlevs()
         if (info == psb_success_ ) &
              & call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
       end do
@@ -903,7 +909,6 @@ contains
   end subroutine amg_z_cnv
 
   subroutine amg_z_clone(prec,precout,info)
-
     implicit none
     class(amg_zprec_type), intent(inout) :: prec
     class(psb_zprec_type), intent(inout) :: precout
@@ -915,7 +920,6 @@ contains
   end subroutine amg_z_clone
 
   subroutine amg_z_inner_clone(prec,precout,info)
-
     implicit none
     class(amg_zprec_type), intent(inout)         :: prec
     class(psb_zprec_type), target, intent(inout) :: precout
@@ -931,8 +935,9 @@ contains
       pout%ctxt          = prec%ctxt
       pout%ag_data       = prec%ag_data
       pout%outer_sweeps  = prec%outer_sweeps
+      pout%nlevs         = prec%nlevs
       if (allocated(prec%precv)) then
-        ln = size(prec%precv)
+        ln = prec%get_nlevs()
         allocate(pout%precv(ln),stat=info)
         if (info /= psb_success_) goto 9999
         if (ln >= 1) then
@@ -940,6 +945,7 @@ contains
         end if
         do lev=2, ln
           if (info /= psb_success_) exit
+!!$          write(0,*) 'Inner_clone must be checked and reimplemented! '
           call prec%precv(lev)%clone(pout%precv(lev),info)
           if (info == psb_success_) then
             pout%precv(lev)%base_a       => pout%precv(lev)%ac
@@ -1019,7 +1025,7 @@ contains
     if (psb_errstatus_fatal()) then
       info = psb_err_internal_error_; goto 9999
     end if
-    nlev   = size(prec%precv)
+    nlev   = prec%get_nlevs()
     level = 1
     do level = 1, nlev
       call prec%precv(level)%allocate_wrk(info,vmold=vmold)
@@ -1042,7 +1048,6 @@ contains
   subroutine amg_z_free_wrk(prec,info)
     use psb_base_mod
     implicit none
-
     ! Arguments
     class(amg_zprec_type), intent(inout) :: prec
     integer(psb_ipk_), intent(out)        :: info
@@ -1059,7 +1064,7 @@ contains
     end if
 
     if (allocated(prec%precv)) then
-      nlev   = size(prec%precv)
+      nlev   = prec%get_nlevs()
       do level = 1, nlev
         call prec%precv(level)%free_wrk(info)
       end do

amgprec/amg_z_slu_solver.F90

@@ -137,7 +137,7 @@ module amg_z_slu_solver
 
   interface
     subroutine amg_z_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       use psb_base_mod
       import amg_z_slu_solver_type
       implicit none 
@@ -147,6 +147,7 @@ module amg_z_slu_solver
       type(psb_z_vect_type),intent(inout)  :: y
       complex(psb_dpk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)           :: trans
+      complex(psb_dpk_),target, intent(inout) :: work(:)
       type(psb_z_vect_type),intent(inout) :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/amg_z_sludist_solver.F90

@@ -212,21 +212,21 @@ contains
   end subroutine z_sludist_solver_apply
 
   subroutine z_sludist_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-       & trans,wv,info,init,initu)
+       & trans,work,wv,info,init,initu)
     use psb_base_mod
-    implicit none
+    implicit none 
     type(psb_desc_type), intent(in)      :: desc_data
     class(amg_z_sludist_solver_type), intent(inout) :: sv
     type(psb_z_vect_type),intent(inout)  :: x
     type(psb_z_vect_type),intent(inout)  :: y
     complex(psb_dpk_),intent(in)            :: alpha,beta
     character(len=1),intent(in)           :: trans
+    complex(psb_dpk_),target, intent(inout) :: work(:)
     type(psb_z_vect_type),intent(inout) :: wv(:)
     integer, intent(out)                  :: info
     character, intent(in), optional                :: init
     type(psb_z_vect_type),intent(inout), optional   :: initu
 
-    complex(psb_dpk_), target :: aux(0)
     integer    :: err_act
     character(len=20)  :: name='z_sludist_solver_apply_vect'
 
@@ -240,7 +240,7 @@ contains
 
     call x%v%sync()
     call y%v%sync()
-    call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,aux,info)
+    call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
     call y%v%set_host()
     if (info /= 0) goto 9999
 

amgprec/amg_z_umf_solver.F90

@@ -138,7 +138,7 @@ module amg_z_umf_solver
   
   interface
     subroutine amg_z_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,wv,info,init,initu)
+         & trans,work,wv,info,init,initu)
       use psb_base_mod
       import amg_z_umf_solver_type
       implicit none 
@@ -148,6 +148,7 @@ module amg_z_umf_solver
       type(psb_z_vect_type),intent(inout)  :: y
       complex(psb_dpk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)           :: trans
+      complex(psb_dpk_),target, intent(inout) :: work(:)
       type(psb_z_vect_type),intent(inout) :: wv(:)
       integer(psb_ipk_), intent(out)                 :: info
       character, intent(in), optional                :: init

amgprec/impl/Makefile

@@ -25,22 +25,22 @@ MPCOBJS=amg_dslud_interface.o amg_zslud_interface.o
 
 DINNEROBJS= amg_dmlprec_bld.o amg_dfile_prec_descr.o amg_dfile_prec_memory_use.o \
 	amg_d_smoothers_bld.o amg_d_hierarchy_bld.o amg_d_hierarchy_rebld.o \
-	amg_dmlprec_aply.o   \
+	amg_dmlprec_aply.o amg_dmlprec_aply_a.o \
 	$(DMPFOBJS) amg_d_extprol_bld.o
 
 SINNEROBJS=   amg_smlprec_bld.o amg_sfile_prec_descr.o amg_sfile_prec_memory_use.o \
 	amg_s_smoothers_bld.o amg_s_hierarchy_bld.o amg_s_hierarchy_rebld.o \
-	amg_smlprec_aply.o   \
+	amg_smlprec_aply.o amg_smlprec_aply_a.o \
 	$(SMPFOBJS) amg_s_extprol_bld.o 
 
 ZINNEROBJS=   amg_zmlprec_bld.o amg_zfile_prec_descr.o amg_zfile_prec_memory_use.o \
 	amg_z_smoothers_bld.o amg_z_hierarchy_bld.o amg_z_hierarchy_rebld.o \
-	amg_zmlprec_aply.o   \
+	amg_zmlprec_aply.o amg_zmlprec_aply_a.o \
 	$(ZMPFOBJS)  amg_z_extprol_bld.o
 
 CINNEROBJS=   amg_cmlprec_bld.o amg_cfile_prec_descr.o amg_cfile_prec_memory_use.o \
 	amg_c_smoothers_bld.o amg_c_hierarchy_bld.o amg_c_hierarchy_rebld.o \
-	amg_cmlprec_aply.o   \
+	amg_cmlprec_aply.o amg_cmlprec_aply_a.o \
 	$(CMPFOBJS)  amg_c_extprol_bld.o
 
 INNEROBJS= $(SINNEROBJS) $(DINNEROBJS) $(CINNEROBJS) $(ZINNEROBJS)

amgprec/impl/aggregator/amg_c_dec_aggregator_mat_asb.f90

@@ -114,63 +114,67 @@ subroutine  amg_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
+  
+  if (me >=0) then 
+    select case(parms%coarse_mat)
 
-  select case(parms%coarse_mat)
+    case(amg_distr_mat_) 
 
-  case(amg_distr_mat_) 
+      call ac%cscnv(info,type='csr')
+      call op_prol%cscnv(info,type='csr')
+      call op_restr%cscnv(info,type='csr')
 
-    call ac%cscnv(info,type='csr')
-    call op_prol%cscnv(info,type='csr')
-    call op_restr%cscnv(info,type='csr')
+      if (debug_level >= psb_debug_outer_) &
+           & write(debug_unit,*) me,' ',trim(name),&
+           & 'Done ac '
 
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done ac '
+    case(amg_repl_mat_) 
+      !
+      ! We are assuming here that an c matrix
+      ! can hold all entries
+      !
+      if (desc_ac%get_global_rows() < huge(1_psb_ipk_) ) then 
+        ntaggr = desc_ac%get_global_rows()
+        i_nr   = ntaggr
+      else
+        info = psb_err_internal_error_
+        call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
+        goto 9999
+      end if
 
-  case(amg_repl_mat_) 
-    !
-    ! We are assuming here that an c matrix
-    ! can hold all entries
-    !
-    if (desc_ac%get_global_rows() < huge(1_psb_ipk_) ) then 
-      ntaggr = desc_ac%get_global_rows()
-      i_nr   = ntaggr
-    else
+      call op_prol%mv_to(tmpcoo)
+      nzl = tmpcoo%get_nzeros()
+      call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
+      call tmpcoo%set_ncols(i_nr)
+      call op_prol%mv_from(tmpcoo)
+
+      call op_restr%mv_to(tmpcoo)
+      nzl = tmpcoo%get_nzeros()
+      call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
+      call tmpcoo%set_nrows(i_nr)
+      call op_restr%mv_from(tmpcoo)
+
+
+      call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
+           & dupl=psb_dupl_add_,keeploc=.false.)
+      call tmp_ac%mv_to(tmpcoo)
+      call ac%mv_from(tmpcoo)
+
+      call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
+      if (info == psb_success_) call psb_cdasb(desc_ac,info)
+
+      if (info /= psb_success_) goto 9999
+
+    case default 
       info = psb_err_internal_error_
       call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
       goto 9999
-    end if
-    
-    call op_prol%mv_to(tmpcoo)
-    nzl = tmpcoo%get_nzeros()
-    call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
-    call tmpcoo%set_ncols(i_nr)
-    call op_prol%mv_from(tmpcoo)
-
-    call op_restr%mv_to(tmpcoo)
-    nzl = tmpcoo%get_nzeros()
-    call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
-    call tmpcoo%set_nrows(i_nr)
-    call op_restr%mv_from(tmpcoo)
-
-
-    call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
-         & dupl=psb_dupl_add_,keeploc=.false.)
-    call tmp_ac%mv_to(tmpcoo)
-    call ac%mv_from(tmpcoo)
-    
-    call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
-    if (info == psb_success_) call psb_cdasb(desc_ac,info)
-
-    if (info /= psb_success_) goto 9999
-
-  case default 
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
-    goto 9999
-  end select
-
-
+    end select
+  else
+    call op_prol%allocate(izero,izero,info)
+    call op_restr%allocate(izero,izero,info)
+    call ac%allocate(izero,izero,info)
+  end if
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_c_dec_aggregator_mat_bld.f90

@@ -139,7 +139,7 @@ subroutine  amg_c_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   use amg_c_prec_type, amg_protect_name => amg_c_dec_aggregator_mat_bld
   use amg_c_inner_mod 
   implicit none
-  
+
   class(amg_c_dec_aggregator_type), target, intent(inout) :: ag
   type(amg_sml_parms), intent(inout)      :: parms 
   type(psb_cspmat_type), intent(in)    :: a
@@ -169,39 +169,46 @@ subroutine  amg_c_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
 
-  !
-  ! Build the coarse-level matrix from the fine-level one, starting from 
-  ! the mapping defined by amg_aggrmap_bld and applying the aggregation
-  ! algorithm specified by 
-  !
-  select case (parms%aggr_prol)
-  case (amg_no_smooth_) 
+  if (me >=0) then 
+    !
+    ! Build the coarse-level matrix from the fine-level one, starting from 
+    ! the mapping defined by amg_aggrmap_bld and applying the aggregation
+    ! algorithm specified by 
+    !
+    select case (parms%aggr_prol)
+    case (amg_no_smooth_) 
 
-    call amg_caggrmat_nosmth_bld(parms%aggr_prol,a,desc_a,ilaggr,&
-            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+      call amg_caggrmat_nosmth_bld(parms%aggr_prol,a,desc_a,ilaggr,&
+           nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
-  case(amg_smooth_prol_,amg_l1_smooth_prol_) 
+    case(amg_smooth_prol_,amg_l1_smooth_prol_) 
 
-    call amg_caggrmat_smth_bld(parms%aggr_prol,a,desc_a,&
-            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,&
-            op_restr,t_prol,info)
+      call amg_caggrmat_smth_bld(parms%aggr_prol,a,desc_a,&
+           ilaggr,nlaggr,parms,ac,desc_ac,op_prol,&
+           op_restr,t_prol,info)
 
 !!$  case(amg_biz_prol_) 
 !!$
 !!$    call amg_caggrmat_biz_bld(a,desc_a,ilaggr,nlaggr, &
 !!$         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
-  
-  case(amg_min_energy_) 
 
-    call amg_caggrmat_minnrg_bld(parms%aggr_prol,a,desc_a,ilaggr,&
-            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    case(amg_min_energy_) 
 
-  case default
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='Invalid aggr kind')
-    goto 9999
+      call amg_caggrmat_minnrg_bld(parms%aggr_prol,a,desc_a,ilaggr,&
+           nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+
+    case default
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,a_err='Invalid aggr kind')
+      goto 9999
+
+    end select
+  else
+    call op_prol%allocate(izero,izero,info)
+    call op_restr%allocate(izero,izero,info)
+    call ac%allocate(izero,izero,info)
+  end if
 
-  end select
   if (info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner aggrmat bld')
     goto 9999
@@ -214,5 +221,5 @@ subroutine  amg_c_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
 9999 call psb_error_handler(err_act)
   return
 
-  
+
 end subroutine amg_c_dec_aggregator_mat_bld

amgprec/impl/aggregator/amg_c_dec_aggregator_tprol.f90

@@ -122,19 +122,23 @@ subroutine  amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
   call amg_check_def(parms%aggr_ord,'Ordering',&
        &   amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
   call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
+  if (me >=0) then 
+    !
+    ! The decoupled aggregator based on SOC measures ignores
+    ! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
+    !
+    if (do_timings) call psb_tic(idx_map_bld)
+    clean_zeros = ag%do_clean_zeros
+    call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
+    if (do_timings) call psb_toc(idx_map_bld)
+    if (do_timings) call psb_tic(idx_map_tprol)
 
-  !
-  ! The decoupled aggregator based on SOC measures ignores
-  ! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
-  !
-  if (do_timings) call psb_tic(idx_map_bld)
-  clean_zeros = ag%do_clean_zeros
-  call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
-  if (do_timings) call psb_toc(idx_map_bld)
-  if (do_timings) call psb_tic(idx_map_tprol)
-
-  if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
-  if (do_timings) call psb_toc(idx_map_tprol)
+    if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
+    if (do_timings) call psb_toc(idx_map_tprol)
+  else
+    allocate(nlaggr(0),ilaggr(0))
+    call t_prol%allocate(lzero,lzero,info)
+  end if
   if (info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

amgprec/impl/aggregator/amg_c_parmatch_aggregator_inner_mat_asb.F90

@@ -1,161 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-! File: amg_c_parmatch_aggregator_mat_asb.f90
-!
-! Subroutine: amg_c_parmatch_aggregator_mat_asb
-! Version:    real
-!
-!
-!  From a given AC to final format, generating DESC_AC.
-!  This is quite involved, because in the context of aggregation based
-!  on parallel matching we are building the matrix hierarchy within BLD_TPROL
-!  as we go, especially if we have multiple sweeps, hence this code is called
-!  in two completely different contexts:
-!  1. Within bld_tprol for the internal hierarchy
-!  2. Outside, from amg_hierarchy_bld
-!  The solution we have found is for bld_tprol to copy its output
-!  into special components ag%ac ag%desc_ac etc so that:
-!  1. if they are  allocated, it means that bld_tprol has been already invoked, we are in
-!     amg_hierarchy_bld and we only need to copy them
-!  2. If they are not allocated, we are within bld_tprol, and we need to actually
-!     perform the various needed steps.
-!
-! Arguments:
-!    ag       -  type(amg_c_parmatch_aggregator_type), input/output.
-!               The aggregator object
-!    parms   -  type(amg_cml_parms), input
-!               The aggregation parameters
-!    a          -  type(psb_cspmat_type), input.
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!    ilaggr     -  integer, dimension(:), input
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that the indices
-!                  are assumed to be shifted so as to make sure the ranges on
-!                  the various processes do not   overlap.
-!    nlaggr     -  integer, dimension(:) input
-!                  nlaggr(i) contains the aggregates held by process i.
-!    ac         -  type(psb_cspmat_type), inout
-!                  The coarse matrix
-!    desc_ac    -  type(psb_desc_type), output.
-!                  The communication descriptor of the fine-level matrix.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!
-!    op_prol    -  type(psb_cspmat_type), input/output
-!                  The tentative prolongator on input, the computed prolongator on output
-!
-!    op_restr    -  type(psb_cspmat_type), input/output
-!                  The restrictor operator; normally, it is the transpose of the prolongator.
-!
-!    info       -  integer, output.
-!                  Error code.
-!
-subroutine  amg_c_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
-     & ac,desc_ac, op_prol,op_restr,info)
-  use psb_base_mod
-  use amg_base_prec_type
-  use amg_c_parmatch_aggregator_mod, amg_protect_name => amg_c_parmatch_aggregator_inner_mat_asb
-  implicit none
-  class(amg_c_parmatch_aggregator_type), target, intent(inout) :: ag
-  type(amg_cml_parms), intent(inout)    :: parms
-  type(psb_cspmat_type), intent(in)     :: a
-  type(psb_desc_type), intent(in)       :: desc_a
-  type(psb_cspmat_type), intent(inout) :: op_prol,op_restr
-  type(psb_cspmat_type), intent(inout)  :: ac
-  type(psb_desc_type), intent(inout)    :: desc_ac
-  integer(psb_ipk_), intent(out)        :: info
-  !
-  type(psb_ctxt_type)         :: ictxt
-  integer(psb_ipk_)           :: np, me
-  type(psb_lc_coo_sparse_mat) :: acoo, bcoo
-  type(psb_lc_csr_sparse_mat) :: acsr1
-  integer(psb_ipk_)           :: nzl, inl
-  integer(psb_lpk_)           :: ntaggr
-  integer(psb_ipk_) :: err_act, debug_level, debug_unit
-  character(len=20) :: name='d_parmatch_inner_mat_asb'
-  character(len=80) :: aname
-  logical, parameter :: debug=.false., dump_prol_restr=.false.
-
-
-  if (psb_get_errstatus().ne.0) return
-  call psb_erractionsave(err_act)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-  info  = psb_success_
-  ictxt = desc_a%get_context()
-  call psb_info(ictxt,me,np)
-
-  if (debug) write(0,*) me,' ',trim(name),' Start:',&
-       & allocated(ag%ac),allocated(ag%desc_ac), allocated(ag%prol),allocated(ag%restr)
-
-  select case(parms%coarse_mat)
-
-  case(amg_distr_mat_)
-    ! Do nothing, it has already been done in spmm_bld_ov.
-
-  case(amg_repl_mat_)
-    !
-    !
-    if (np>1) then 
-      info = psb_err_internal_error_
-      call psb_errpush(info,name,a_err='no repl coarse_mat_ here')
-      goto 9999
-    end if
-  case default
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
-    goto 9999
-  end select
-
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-  return
-
-
-end subroutine amg_c_parmatch_aggregator_inner_mat_asb

amgprec/impl/aggregator/amg_c_parmatch_aggregator_mat_asb.F90

@@ -1,203 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-! File: amg_c_parmatch_aggregator_mat_asb.f90
-!
-! Subroutine: amg_c_parmatch_aggregator_mat_asb
-! Version:    real
-!
-!
-!  From a given AC to final format, generating DESC_AC.
-!  This is quite involved, because in the context of aggregation based
-!  on parallel matching we are building the matrix hierarchy within BLD_TPROL
-!  as we go, especially if we have multiple sweeps, hence this code is called
-!  in two completely different contexts:
-!  1. Within bld_tprol for the internal hierarchy
-!  2. Outside, from amg_hierarchy_bld
-!  The solution we have found is for bld_tprol to copy its output
-!  into special components ag%ac ag%desc_ac etc so that:
-!  1. if they are  allocated, it means that bld_tprol has been already invoked, we are in
-!     amg_hierarchy_bld and we only need to copy them
-!  2. If they are not allocated, we are within bld_tprol, and we need to actually
-!     perform the various needed steps.
-!
-! Arguments:
-!    ag       -  type(amg_c_parmatch_aggregator_type), input/output.
-!               The aggregator object
-!    parms   -  type(amg_cml_parms), input
-!               The aggregation parameters
-!    a          -  type(psb_cspmat_type), input.
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!    ilaggr     -  integer, dimension(:), input
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that the indices
-!                  are assumed to be shifted so as to make sure the ranges on
-!                  the various processes do not   overlap.
-!    nlaggr     -  integer, dimension(:) input
-!                  nlaggr(i) contains the aggregates held by process i.
-!    ac         -  type(psb_cspmat_type), inout
-!                  The coarse matrix
-!    desc_ac    -  type(psb_desc_type), output.
-!                  The communication descriptor of the fine-level matrix.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!
-!    op_prol    -  type(psb_cspmat_type), input/output
-!                  The tentative prolongator on input, the computed prolongator on output
-!
-!    op_restr    -  type(psb_cspmat_type), input/output
-!                  The restrictor operator; normally, it is the transpose of the prolongator.
-!
-!    info       -  integer, output.
-!                  Error code.
-!
-subroutine  amg_c_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
-     & ac,desc_ac, op_prol,op_restr,info)
-  use psb_base_mod
-  use amg_base_prec_type
-  use amg_c_parmatch_aggregator_mod, amg_protect_name => amg_c_parmatch_aggregator_mat_asb
-  implicit none
-  class(amg_c_parmatch_aggregator_type), target, intent(inout) :: ag
-  type(amg_cml_parms), intent(inout)    :: parms
-  type(psb_cspmat_type), intent(in)     :: a
-  type(psb_desc_type), intent(inout)    :: desc_a
-  type(psb_cspmat_type), intent(inout) :: op_prol,ac,op_restr
-  type(psb_desc_type), intent(inout)    :: desc_ac
-  integer(psb_ipk_), intent(out)        :: info
-  !
-  type(psb_ctxt_type)         :: ctxt
-  integer(psb_ipk_)           :: np, me
-  type(psb_lc_coo_sparse_mat) :: tmpcoo
-  type(psb_lcspmat_type)      :: tmp_ac
-  integer(psb_ipk_)           :: i_nr, i_nc, i_nl, nzl
-  integer(psb_lpk_)           :: ntaggr
-  integer(psb_ipk_) :: err_act, debug_level, debug_unit
-  character(len=20) :: name='d_parmatch_mat_asb'
-  character(len=80) :: aname
-  logical, parameter :: debug=.false., dump_prol_restr=.false., dump_ac=.false.
-
-
-  call psb_erractionsave(err_act)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-  info  = psb_success_
-  ctxt = desc_a%get_context()
-  call psb_info(ctxt,me,np)
-  if (psb_get_errstatus().ne.0) then
-    write(0,*) me,' From:',trim(name),':',psb_get_errstatus()
-    return
-  end if
-
-  if (debug) write(0,*) me,' ',trim(name),' Start:',&
-       & allocated(ag%ac),allocated(ag%desc_ac), allocated(ag%prol),allocated(ag%restr)
-
-  select case(parms%coarse_mat)
-
-  case(amg_distr_mat_)
-
-    call ac%cscnv(info,type='csr')
-    call op_prol%cscnv(info,type='csr')
-    call op_restr%cscnv(info,type='csr')
-
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done ac '
-
-  case(amg_repl_mat_)
-    !
-    ! We are assuming here that an d matrix
-    ! can hold all entries
-    !
-    if (desc_ac%get_global_rows() < huge(1_psb_ipk_) ) then
-      ntaggr = desc_ac%get_global_rows()
-      i_nr   = ntaggr
-    else
-      info = psb_err_internal_error_
-      call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
-      goto 9999
-    end if
-
-    call op_prol%mv_to(tmpcoo)
-    nzl = tmpcoo%get_nzeros()
-    call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
-    call tmpcoo%set_ncols(i_nr)
-    call op_prol%mv_from(tmpcoo)
-
-    call op_restr%mv_to(tmpcoo)
-    nzl = tmpcoo%get_nzeros()
-    call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
-    call tmpcoo%set_nrows(i_nr)
-    call op_restr%mv_from(tmpcoo)
-
-    call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
-         & dupl=psb_dupl_add_,keeploc=.false.)
-    call tmp_ac%mv_to(tmpcoo)
-    call ac%mv_from(tmpcoo)
-
-    call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
-    if (info == psb_success_) call psb_cdasb(desc_ac,info)
-    !
-    ! Now that we have the descriptors and the restrictor, we should
-    ! update the W. But we don't, because REPL is only valid
-    ! at the coarsest level, so no need to carry over.
-    !
-
-    if (info /= psb_success_) goto 9999
-
-  case default
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
-    goto 9999
-  end select
-
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-  return
-
-
-end subroutine amg_c_parmatch_aggregator_mat_asb

amgprec/impl/aggregator/amg_c_parmatch_aggregator_mat_bld.F90

@@ -1,244 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-! File: amg_c_base_aggregator_mat_bld.f90
-!
-! Subroutine: amg_c_base_aggregator_mat_bld
-! Version:    c
-!
-!  This routine builds the matrix associated to the current level of the
-!  multilevel preconditioner from the matrix associated to the previous level,
-!  by using the user-specified aggregation technique (therefore, it also builds the
-!  prolongation and restriction operators mapping the current level to the
-!  previous one and vice versa).
-!  The current level is regarded as the coarse one, while the previous as
-!  the fine one. This is in agreement with the fact that the routine is called,
-!  by amg_mlprec_bld, only on levels >=2.
-!  The coarse-level matrix A_C is built from a fine-level matrix A
-!  by using the Galerkin approach, i.e.
-!
-!                               A_C = P_C^T A P_C,
-!
-!  where P_C is a prolongator from the coarse level to the fine one.
-!
-!  A mapping from the nodes of the adjacency graph of A to the nodes of the
-!  adjacency graph of A_C has been computed by the amg_aggrmap_bld subroutine.
-!  The prolongator P_C is built here from this mapping, according to the
-!  value of p%iprcparm(amg_aggr_kind_), specified by the user through
-!  amg_cprecinit and amg_zprecset.
-!  On output from this routine the entries of AC, op_prol, op_restr
-!  are still in "global numbering" mode; this is fixed in the calling routine
-!  amg_c_lev_aggrmat_bld.
-!
-!  Currently four  different prolongators are implemented, corresponding to
-!  four  aggregation algorithms:
-!  1. un-smoothed aggregation,
-!  2. smoothed aggregation,
-!  3. "bizarre" aggregation.
-!  4. minimum energy
-!  1. The non-smoothed aggregation uses as prolongator the piecewise constant
-!     interpolation operator corresponding to the fine-to-coarse level mapping built
-!     by p%aggr%bld_tprol. This is called tentative prolongator.
-!  2. The smoothed aggregation uses as prolongator the operator obtained by applying
-!     a damped Jacobi smoother to the tentative prolongator.
-!  3. The "bizarre" aggregation uses a prolongator proposed by the authors of AMG4PSBLAS.
-!     This prolongator still requires a deep analysis and testing and its use is
-!     not recommended.
-!  4. Minimum energy aggregation
-!
-!  For more details see
-!    M. Brezina and P. Vanek, A black-box iterative solver based on a two-level
-!    Schwarz method, Computing,  63 (1999), 233-263.
-!    P. D'Ambra, D. di Serafino and S. Filippone, On the development of PSBLAS-based
-!    parallel two-level Schwarz preconditioners, Appl. Num. Math., 57 (2007),
-!    1181-1196.
-!    M. Sala, R. Tuminaro: A new Petrov-Galerkin smoothed aggregation preconditioner
-!    for nonsymmetric linear systems, SIAM J. Sci. Comput., 31(1):143-166 (2008)
-!
-!
-!  The main structure is:
-!  1. Perform sanity checks;
-!  2. Compute prolongator/restrictor/AC
-!
-!
-! Arguments:
-!    ag       -  type(amg_c_base_aggregator_type), input/output.
-!               The aggregator object
-!    parms   -  type(amg_cml_parms), input
-!               The aggregation parameters
-!    a          -  type(psb_cspmat_type), input.
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!    ilaggr     -  integer, dimension(:), input
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that the indices
-!                  are assumed to be shifted so as to make sure the ranges on
-!                  the various processes do not   overlap.
-!    nlaggr     -  integer, dimension(:) input
-!                  nlaggr(i) contains the aggregates held by process i.
-!    ac         -  type(psb_cspmat_type), output
-!                  The coarse matrix on output
-!
-!    op_prol    -  type(psb_cspmat_type), input/output
-!                  The tentative prolongator on input, the computed prolongator on output
-!
-!    op_restr    -  type(psb_cspmat_type), output
-!                  The restrictor operator; normally, it is the transpose of the prolongator.
-!
-!    info       -  integer, output.
-!                  Error code.
-!
-subroutine  amg_c_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
-  use psb_base_mod
-  use amg_c_inner_mod
-  use amg_base_prec_type
-  use amg_c_parmatch_aggregator_mod, amg_protect_name => amg_c_parmatch_aggregator_mat_bld
-  implicit none
-
-  class(amg_c_parmatch_aggregator_type), target, intent(inout) :: ag
-  type(amg_sml_parms), intent(inout)    :: parms
-  type(psb_cspmat_type), intent(in)     :: a
-  type(psb_desc_type), intent(inout)    :: desc_a
-  integer(psb_lpk_), intent(inout)      :: ilaggr(:), nlaggr(:)
-  type(psb_lcspmat_type), intent(inout) :: t_prol
-  type(psb_cspmat_type), intent(out)   :: op_prol,ac,op_restr
-  type(psb_desc_type), intent(inout)    :: desc_ac
-  integer(psb_ipk_), intent(out)        :: info
-
-  ! Local variables
-  character(len=20)     :: name
-  type(psb_ctxt_type)   :: ictxt
-  integer(psb_ipk_)     :: np, me
-  integer(psb_ipk_)     :: err_act
-  integer(psb_ipk_)     :: debug_level, debug_unit
-  type(psb_cspmat_type) :: atmp
-
-  name='c_parmatch_mat_bld'
-  if (psb_get_errstatus().ne.0) return
-  call psb_erractionsave(err_act)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-  info  = psb_success_
-  ictxt = desc_a%get_context()
-  call psb_info(ictxt,me,np)
-
-
-  !
-  ! Build the coarse-level matrix from the fine-level one, starting from
-  ! the mapping defined by amg_aggrmap_bld and applying the aggregation
-  ! algorithm specified by
-  !
-
-  call clean_shortcuts(ag)
-  !
-  ! When requesting smoothed aggregation we cannot use the
-  ! unsmoothed shortcuts
-  !
-  select case (parms%aggr_prol)
-  case (amg_no_smooth_)
-    call amg_c_parmatch_unsmth_bld(parms%aggr_prol,ag,a,desc_a,&
-            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,op_restr,&
-            t_prol,info)
-
-  case(amg_smooth_prol_,amg_l1_smooth_prol_)
-    call amg_c_parmatch_smth_bld(parms%aggr_prol,ag,a,desc_a,&
-            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,op_restr,&
-            t_prol,info)
-
-!!$  case(amg_biz_prol_)
-!!$    call amg_caggrmat_biz_bld(a,desc_a,ilaggr,nlaggr, &
-!!$         & parms,ac,desc_ac,op_prol,op_restr,info)
-
-  case(amg_min_energy_)
-    call amg_caggrmat_minnrg_bld(parms%aggr_prol,a,desc_a,&
-            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,op_restr,&
-            t_prol,info)
-
-  case default
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='Invalid aggr kind')
-    goto 9999
-  end select
-
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner aggrmat asb')
-    goto 9999
-  end if
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-  return
-
-
-contains
-  subroutine clean_shortcuts(ag)
-    implicit none
-    class(amg_c_parmatch_aggregator_type), intent(inout) :: ag
-    integer(psb_ipk_) :: info
-    if (allocated(ag%prol)) then
-      call ag%prol%free()
-      deallocate(ag%prol)
-    end if
-    if (allocated(ag%restr)) then
-      call ag%restr%free()
-      deallocate(ag%restr)
-    end if
-    if (ag%unsmoothed_hierarchy) then
-      if (allocated(ag%ac)) call move_alloc(ag%ac, ag%rwa)
-      if (allocated(ag%desc_ac)) call move_alloc(ag%desc_ac,ag%rwdesc)
-    else
-      if (allocated(ag%ac)) then
-        call ag%ac%free()
-        deallocate(ag%ac)
-      end if
-      if (allocated(ag%desc_ac)) then
-        call ag%desc_ac%free(info)
-        deallocate(ag%desc_ac)
-      end if
-    end if
-  end subroutine clean_shortcuts
-end subroutine amg_c_parmatch_aggregator_mat_bld

amgprec/impl/aggregator/amg_c_parmatch_aggregator_tprol.F90

@@ -1,470 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-! File: amg_c_parmatch_aggregator_tprol.f90
-!
-! Subroutine: amg_c_parmatch_aggregator_tprol
-! Version:    real
-!
-!
-
-subroutine  amg_c_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
-     & a,desc_a,ilaggr,nlaggr,t_prol,info)
-  use psb_base_mod
-  use amg_base_prec_type
-  use amg_c_inner_mod
-  use amg_c_parmatch_aggregator_mod, amg_protect_name => amg_c_parmatch_aggregator_build_tprol
-  use iso_c_binding
-  implicit none
-  class(amg_c_parmatch_aggregator_type), target, intent(inout) :: ag
-  type(amg_sml_parms), intent(inout)   :: parms
-  type(amg_saggr_data), intent(in)     :: ag_data
-  type(psb_cspmat_type), intent(inout) :: a
-  type(psb_desc_type), intent(inout)      :: desc_a
-  integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
-  type(psb_lcspmat_type), intent(out)  :: t_prol
-  integer(psb_ipk_), intent(out)      :: info
-
-
-  ! Local variables
-  real(psb_spk_), allocatable    :: tmpw(:), tmpwnxt(:)
-  integer(psb_lpk_), allocatable :: ixaggr(:), nxaggr(:), tlaggr(:), ivr(:)
-  type(psb_cspmat_type)          :: a_tmp
-  integer(psb_ipk_)    :: match_algorithm, n_sweeps
-  integer(psb_lpk_)    :: target_csize
-  character(len=40)    :: name, ch_err
-  character(len=80)    :: fname, prefix_
-  type(psb_ctxt_type)  :: ictxt
-  integer(psb_ipk_)    :: np, me
-  integer(psb_ipk_)    :: err_act, ierr
-  integer(psb_ipk_)    :: debug_level, debug_unit
-  integer(psb_ipk_)    :: i, j, k, nr, nc
-  integer(psb_lpk_)    :: isz, num_pcols, nrac, ncac, lname, nz, x_sweeps, csz
-  integer(psb_lpk_)    :: psz, sizes(4)
-  type(psb_c_csr_sparse_mat), target  :: csr_prol, csr_pvi, csr_prod_res, acsr
-  type(psb_lc_csr_sparse_mat), target :: lcsr_prol
-  type(psb_desc_type), allocatable    :: desc_acv(:)
-  type(psb_lc_coo_sparse_mat)         :: tmpcoo, transp_coo
-  type(psb_cspmat_type), allocatable  :: acv(:)
-  type(psb_cspmat_type), allocatable  :: prolv(:), restrv(:)
-  type(psb_lcspmat_type)              :: tmp_prol, tmp_pg, tmp_restr
-  type(psb_desc_type)                 :: tmp_desc_ac, tmp_desc_ax, tmp_desc_p
-  integer(psb_ipk_), save             :: idx_mboxp=-1, idx_spmmbld=-1, idx_sweeps_mult=-1
-  logical, parameter :: dump=.false., do_timings=.false., debug=.false., &
-       & dump_prol_restr=.false.
-
-  name='c_parmatch_tprol'
-  ictxt = desc_a%get_context()
-  call psb_info(ictxt,me,np)
-  if (psb_get_errstatus().ne.0) then
-    write(0,*) me,trim(name),' Err_status :',psb_get_errstatus()
-    return
-  end if
-  if (debug) write(0,*) me,trim(name),' Start '
-  call psb_erractionsave(err_act)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-  info  = psb_success_
-
-  if ((do_timings).and.(idx_mboxp==-1))       &
-       & idx_mboxp = psb_get_timer_idx("PMC_TPROL: MatchBoxP")
-  if ((do_timings).and.(idx_spmmbld==-1))     &
-       & idx_spmmbld = psb_get_timer_idx("PMC_TPROL: spmm_bld")
-  if ((do_timings).and.(idx_sweeps_mult==-1)) &
-       & idx_sweeps_mult = psb_get_timer_idx("PMC_TPROL: sweeps_mult")
-
-
-  call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
-       &   amg_mult_ml_,is_legal_ml_cycle)
-  call amg_check_def(parms%par_aggr_alg,'Aggregation',&
-       &   amg_coupled_aggr_,is_legal_coupled_par_aggr_alg)
-  call amg_check_def(parms%aggr_ord,'Ordering',&
-       &   amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
-  call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',czero,is_legal_c_aggr_thrs)
-
-  match_algorithm = ag%matching_alg
-  n_sweeps        = ag%n_sweeps
-  if (2**n_sweeps /= ag%orig_aggr_size) then
-    if (me == 0) then
-      write(debug_unit, *) 'Warning: AGGR_SIZE reset to value ',2**n_sweeps
-    end if
-  end if
-  if (ag_data%target_coarse_size > 0) then
-    target_csize       = ag_data%target_coarse_size
-  else
-    target_csize       = ag_data%min_coarse_size
-  end if
-  if (.true.) then
-    block
-      integer(psb_ipk_) :: ipv(2)
-      ipv(1) = target_csize
-      ipv(2) = n_sweeps
-      call psb_bcast(ictxt,ipv)
-      target_csize = ipv(1)
-      n_sweeps  = ipv(2)
-    end block
-  else
-    call psb_bcast(ictxt,target_csize)
-    call psb_bcast(ictxt,n_sweeps)
-  end if
-  if (n_sweeps /= ag%n_sweeps) then
-    write(0,*) me,' Inconsistent N_SWEEPS ',n_sweeps,ag%n_sweeps
-  end if
-!!$  if (me==0) write(0,*) 'Matching sweeps: ',n_sweeps
-  n_sweeps = max(1,n_sweeps)
-  if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,target_csize
-  if (ag%unsmoothed_hierarchy.and.allocated(ag%base_a)) then
-    call ag%base_a%cp_to(acsr)
-    if (ag%do_clean_zeros) call acsr%clean_zeros(info)
-    nr = acsr%get_nrows()
-    if (psb_size(ag%w) < nr) call ag%bld_default_w(nr)
-    isz = acsr%get_ncols()
-
-    call psb_realloc(isz,ixaggr,info)
-    if (info == psb_success_) &
-         & allocate(acv(0:n_sweeps), desc_acv(0:n_sweeps),&
-         &  prolv(n_sweeps), restrv(n_sweeps),stat=info)
-
-    if (info /= psb_success_) then
-      info=psb_err_from_subroutine_
-      ch_err='psb_realloc'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-
-    end if
-
-
-    call acv(0)%mv_from(acsr)
-    call ag%base_desc%clone(desc_acv(0),info)
-
-  else
-    call a%cp_to(acsr)
-    if (ag%do_clean_zeros) call acsr%clean_zeros(info)
-    nr = acsr%get_nrows()
-    if (psb_size(ag%w) < nr) call ag%bld_default_w(nr)
-    isz = acsr%get_ncols()
-
-    call psb_realloc(isz,ixaggr,info)
-    if (info == psb_success_) &
-         & allocate(acv(0:n_sweeps), desc_acv(0:n_sweeps),&
-         &  prolv(n_sweeps), restrv(n_sweeps),stat=info)
-
-    if (info /= psb_success_) then
-      info=psb_err_from_subroutine_
-      ch_err='psb_realloc'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-
-    end if
-
-
-    call acv(0)%mv_from(acsr)
-    call desc_a%clone(desc_acv(0),info)
-  end if
-
-  nrac = desc_acv(0)%get_local_rows()
-  ncac = desc_acv(0)%get_local_cols()
-  if (debug) write(0,*) me,' On input to level: ',nrac, ncac
-  if (allocated(ag%prol)) then
-    call ag%prol%free()
-    deallocate(ag%prol)
-  end if
-  if (allocated(ag%restr)) then
-    call ag%restr%free()
-    deallocate(ag%restr)
-  end if
-
-  if (dump) then
-    block
-      type(psb_lcspmat_type) :: lac
-      ivr = desc_acv(0)%get_global_indices(owned=.false.)
-      prefix_ = "input_a"
-      lname = len_trim(prefix_)
-      fname = trim(prefix_)
-      write(fname(lname+1:lname+9),'(a,i3.3,a)') '_p',me, '.mtx'
-      call acv(0)%print(fname,head='Debug aggregates')
-      call lac%cp_from(acv(0))
-      write(fname(lname+1:lname+13),'(a,i3.3,a)') '_p',me, '-glb.mtx'
-      call lac%print(fname,head='Debug aggregates',iv=ivr)
-      call lac%free()
-    end block
-  end if
-
-  call psb_geall(tmpw,desc_acv(0),info)
-
-  tmpw(1:nr) = ag%w(1:nr)
-
-  call psb_geasb(tmpw,desc_acv(0),info)
-
-  if (debug) then
-    call psb_barrier(ictxt)
-    if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),target_csize
-  end if
-
-  !
-  ! Prepare ag%ac, ag%desc_ac, ag%prol, ag%restr to enable
-  !         shortcuts in mat_bld and mat_asb
-  ! and ag%desc_ax which will be needed in backfix.
-  !
-  x_sweeps = -1
-  sweeps_loop: do i=1, n_sweeps
-    if (debug) then
-      call psb_barrier(ictxt)
-      if (me==0) write(0,*) me,trim(name),' Start sweeps_loop iteration:',i,' of ',n_sweeps
-    end if
-
-    !
-    ! Building prol and restr because this algorithm is not decoupled
-    ! On exit from matchbox_build_prol,  prolv(i) is in global numbering
-    !
-    !
-    if (debug) write(0,*) me,' Into matchbox_build_prol ',info
-    if (do_timings) call psb_tic(idx_mboxp)
-    call amg_c_matchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,&
-         & symmetrize=ag%need_symmetrize,reproducible=ag%reproducible_matching)
-    if (do_timings) call psb_toc(idx_mboxp)
-    if (debug) write(0,*) me,' Out from matchbox_build_prol ',info
-    if (psb_errstatus_fatal())  write(0,*)me,trim(name),'Error fatal on exit bld_tprol',info
-
-
-    if (debug) then
-      call psb_barrier(ictxt)
-!!$      write(0,*) name,' Call spmm_bld sweep:',i,n_sweeps
-      if (me==0) write(0,*) me,trim(name),' Calling spmm_bld  NSW>1:',i,&
-           & desc_acv(i-1)%get_local_rows(),desc_acv(i-1)%get_local_cols(),&
-           & desc_acv(i-1)%get_global_rows()
-    end if
-    if (i == n_sweeps) call tmp_prol%clone(tmp_pg,info)
-    if (do_timings) call psb_tic(idx_spmmbld)
-    !
-    !  On entry, prolv(i) is in global numbering,
-    !
-    call amg_c_parmatch_spmm_bld_ov(acv(i-1),desc_acv(i-1),ixaggr,nxaggr,parms,&
-         & acv(i),desc_acv(i), prolv(i),restrv(1),tmp_prol,info)
-    if (psb_errstatus_fatal())  write(0,*)me,trim(name),'Error fatal on exit from bld_ov(i)',info
-    if (debug) then
-      call psb_barrier(ictxt)
-      if (me==0) write(0,*) me,trim(name),' Done spmm_bld:',i
-    end if
-
-    if (do_timings) call psb_toc(idx_spmmbld)
-    ! Keep a copy of prolv(i) in global numbering for the time being, will
-    ! need it to build the final
-    ! if (i == n_sweeps) call prolv(i)%clone(tmp_prol,info)
-    call ag%inner_mat_asb(parms,acv(i-1),desc_acv(i-1),&
-         & acv(i),desc_acv(i),prolv(i),restrv(1),info)
-
-    if (debug) then
-      call psb_barrier(ictxt)
-      if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),target_csize,info
-      csz = sum(nxaggr)
-      call psb_bcast(ictxt,csz)
-      if (csz /= sum(nxaggr)) write(0,*) me,trim(name),' Mismatch matasb',&
-           & csz,sum(nxaggr),target_csize
-    end if
-    if (psb_errstatus_fatal())  write(0,*)me,trim(name),'Error fatal on entry to tmpwnxt 2'
-
-
-    !
-    ! Fix wnxt
-    !
-    if (info == 0) call psb_geall(tmpwnxt,desc_acv(i),info)
-    if (info == 0) call psb_geasb(tmpwnxt,desc_acv(i),info,scratch=.true.)
-    if (info == 0) call psb_halo(tmpw,desc_acv(i-1),info)
-!!$      write(0,*) trestr%get_nrows(),size(tmpwnxt),trestr%get_ncols(),size(tmpw)
-
-    if (info == 0) call psb_csmm(cone,restrv(1),tmpw,czero,tmpwnxt,info)
-
-    if (info /= psb_success_) then
-      write(0,*)me,trim(name),'Error from mat_asb/tmpw ',info
-      info=psb_err_from_subroutine_
-      call psb_errpush(info,name,a_err='mat_asb 2')
-      goto 9999
-    end if
-
-
-    if (i == 1) then
-      nrac = desc_acv(1)%get_local_rows()
-!!$      write(0,*) 'Copying output w_nxt ',nrac
-      call psb_realloc(nrac,ag%w_nxt,info)
-      ag%w_nxt(1:nrac) = tmpwnxt(1:nrac)
-      !
-      !  ILAGGR is fixed later on, but
-      !  get a copy in case of an early exit
-      !
-      call psb_safe_ab_cpy(ixaggr,ilaggr,info)
-    end if
-    call psb_safe_ab_cpy(nxaggr,nlaggr,info)
-    call move_alloc(tmpwnxt,tmpw)
-    if (debug) then
-      if (csz /= sum(nlaggr)) write(0,*) me,trim(name),' Mismatch 2 matasb',&
-           & csz,sum(nlaggr),target_csize, info
-    end if
-    call acv(i-1)%free()
-    if ((sum(nlaggr) <= target_csize).or.(any(nlaggr==0))) then
-      x_sweeps = i
-      exit sweeps_loop
-    end if
-    if (debug) then
-      call psb_barrier(ictxt)
-      if (me==0) write(0,*) me,trim(name),' Done sweeps_loop iteration:',i,' of ',n_sweeps
-    end if
-
-  end do sweeps_loop
-
-  if (debug) then
-    call psb_barrier(ictxt)
-    if (me==0) write(0,*) me,trim(name),' Done sweeps_loop:',x_sweeps
-  end if
-  if (x_sweeps<=0) x_sweeps = n_sweeps
-
-  if (do_timings) call psb_tic(idx_sweeps_mult)
-  !
-  ! Ok, now we have all the prolongators, including the last one in global numbering.
-  ! Build the product of all prolongators. Need a tmp_desc_ax
-  ! which is correct but most of the time overdimensioned
-  !
-  if (.not.allocated(ag%desc_ax)) allocate(ag%desc_ax)
-  !
-  block
-    integer(psb_ipk_) :: i, nnz
-    integer(psb_lpk_) :: ncol, ncsave
-    if (.not.allocated(ag%ac)) allocate(ag%ac)
-    if (.not.allocated(ag%desc_ac)) allocate(ag%desc_ac)
-    call desc_acv(x_sweeps)%clone(ag%desc_ac,info)
-    call desc_acv(x_sweeps)%free(info)
-    call acv(x_sweeps)%move_alloc(ag%ac,info)
-    if (.not.allocated(ag%prol)) allocate(ag%prol)
-    if (.not.allocated(ag%restr)) allocate(ag%restr)
-
-    call psb_cd_reinit(ag%desc_ac,info)
-    ncsave =  ag%desc_ac%get_global_rows()
-    !
-    ! Note: prolv(i) is already in local numbering
-    ! because of the call to mat_asb in the loop above.
-    !
-    call prolv(x_sweeps)%mv_to(csr_prol)
-    if (debug) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'Enter prolongator product loop ',x_sweeps
-    end if
-
-    do i=x_sweeps-1, 1, -1
-      call prolv(i)%mv_to(csr_pvi)
-      if (psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 1'
-      call psb_par_spspmm(csr_pvi,desc_acv(i),csr_prol,csr_prod_res,ag%desc_ac,info)
-      if ((info /=0).or.psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 2',info
-      call csr_pvi%free()
-      call csr_prod_res%mv_to_fmt(csr_prol,info)
-      if ((info /=0).or.psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 3',info
-      call csr_prol%set_ncols(ag%desc_ac%get_local_cols())
-      if ((info /=0).or.psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 4'
-    end do
-    call csr_prol%mv_to_lfmt(lcsr_prol,info)
-    nnz = lcsr_prol%get_nzeros()
-    call ag%desc_ac%l2gip(lcsr_prol%ja(1:nnz),info)
-    call lcsr_prol%set_ncols(ncsave)
-    if (debug) then
-      call psb_barrier(ictxt)
-      if (me == 0) write(0,*) 'Done prolongator product loop ',x_sweeps
-    end if
-    !
-    ! Fix ILAGGR here by copying from CSR_PROL%JA
-    !
-    block
-      integer(psb_ipk_) :: nr
-      nr = lcsr_prol%get_nrows()
-      if (nnz /= nr) then
-        write(0,*) me,name,' Issue with prolongator? ',nr,nnz
-      end if
-      call psb_realloc(nr,ilaggr,info)
-      ilaggr(1:nnz) = lcsr_prol%ja(1:nnz)
-    end block
-    call tmp_prol%mv_from(lcsr_prol)
-    call psb_cdasb(ag%desc_ac,info)
-    call ag%ac%set_ncols(ag%desc_ac%get_local_cols())
-  end block
-
-  call tmp_prol%move_alloc(t_prol,info)
-  call t_prol%set_ncols(ag%desc_ac%get_local_cols())
-  call t_prol%set_nrows(desc_acv(0)%get_local_rows())
-
-  nrac = ag%desc_ac%get_local_rows()
-  ncac = ag%desc_ac%get_local_cols()
-  call psb_realloc(nrac,ag%w_nxt,info)
-  ag%w_nxt(1:nrac) = tmpw(1:nrac)
-
-
-  if (do_timings) call psb_toc(idx_sweeps_mult)
-
-  if (debug) then
-    call psb_barrier(ictxt)
-    if (me == 0) write(0,*) 'Out of build loop ',x_sweeps,': Output size:',sum(nlaggr)
-  end if
-
-
-  !call psb_set_debug_level(0)
-  if (dump) then
-    block
-      ivr = desc_acv(x_sweeps)%get_global_indices(owned=.false.)
-      prefix_ = "final_ac"
-      lname = len_trim(prefix_)
-      fname = trim(prefix_)
-      write(fname(lname+1:lname+9),'(a,i3.3,a)') '_p',me, '.mtx'
-      call acv(x_sweeps)%print(fname,head='Debug aggregates')
-      write(fname(lname+1:lname+13),'(a,i3.3,a)') '_p',me, '-glb.mtx'
-      call acv(x_sweeps)%print(fname,head='Debug aggregates',iv=ivr)
-      prefix_ = "final_tp"
-      lname = len_trim(prefix_)
-      fname = trim(prefix_)
-      write(fname(lname+1:lname+9),'(a,i3.3,a)') '_p',me, '.mtx'
-      call t_prol%print(fname,head='Tentative prolongator')
-    end block
-  end if
-
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_bootCMatch_if')
-    goto 9999
-  end if
-
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-  return
-
-end subroutine amg_c_parmatch_aggregator_build_tprol

amgprec/impl/aggregator/amg_c_parmatch_smth_bld.F90

@@ -1,428 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-! File: amg_caggrmat_smth_bld.F90
-!
-! Subroutine: amg_caggrmat_smth_bld
-! Version:    real
-!
-!  This routine builds a coarse-level matrix A_C from a fine-level matrix A
-!  by using the Galerkin approach, i.e.
-!
-!                               A_C = P_C^T A P_C,
-!
-!  where P_C is a prolongator from the coarse level to the fine one.
-!
-!  The prolongator P_C is built according to a smoothed aggregation algorithm,
-!  i.e. it is obtained by applying a damped Jacobi smoother to the piecewise
-!  constant interpolation operator P corresponding to the fine-to-coarse level
-!  mapping built by the amg_aggrmap_bld subroutine:
-!
-!                            P_C = (I - omega*D^(-1)A) * P,
-!
-!  where D is the diagonal matrix with main diagonal equal to the main diagonal
-!  of A, and omega is a suitable smoothing parameter. An estimate of the spectral
-!  radius of D^(-1)A, to be used in the computation of omega, is provided,
-!  according to the value of p%parms%aggr_omega_alg, specified by the user
-!  through amg_cprecinit and amg_zprecset.
-!
-!  The coarse-level matrix A_C is distributed among the parallel processes or
-!  replicated on each of them, according to the value of p%parms%coarse_mat,
-!  specified by the user through amg_cprecinit and amg_zprecset.
-!  On output from this routine the entries of AC, op_prol, op_restr
-!  are still in "global numbering" mode; this is fixed in the calling routine
-!  aggregator%mat_bld.
-!
-!
-! Arguments:
-!    dol1smoothing - Select between l1-Jacobi and Jacobi as smoother for the
-!                  tentative prolongator
-!    a          -  type(psb_cspmat_type), input.
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!    p          -  type(amg_c_onelev_type), input/output.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!    parms      -   type(amg_cml_parms), input
-!                  Parameters controlling the choice of algorithm
-!    ac         -  type(psb_cspmat_type), output
-!                  The coarse matrix on output
-!
-!    ilaggr     -  integer, dimension(:), input
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that the indices
-!                  are assumed to be shifted so as to make sure the ranges on
-!                  the various processes do not   overlap.
-!    nlaggr     -  integer, dimension(:) input
-!                  nlaggr(i) contains the aggregates held by process i.
-!    op_prol    -  type(psb_cspmat_type), input/output
-!                  The tentative prolongator on input, the computed prolongator on output
-!
-!    op_restr    -  type(psb_cspmat_type), output
-!                  The restrictor operator; normally, it is the transpose of the prolongator.
-!
-!    info       -  integer, output.
-!                  Error code.
-!
-subroutine amg_c_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
-  use psb_base_mod
-  use amg_base_prec_type
-  use amg_c_inner_mod
-  use amg_c_base_aggregator_mod
-  use amg_c_parmatch_aggregator_mod, amg_protect_name => amg_c_parmatch_smth_bld
-  implicit none
-
-  ! Arguments
-  integer(psb_ipk_), intent(in)            :: dol1smoothing
-  class(amg_c_parmatch_aggregator_type), target, intent(inout) :: ag
-  type(psb_cspmat_type), intent(in)      :: a
-  type(psb_desc_type), intent(inout)     :: desc_a
-  integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
-  type(amg_sml_parms), intent(inout)    :: parms
-  type(psb_lcspmat_type), intent(inout)  :: t_prol
-  type(psb_cspmat_type), intent(inout)   :: op_prol,ac,op_restr
-  type(psb_desc_type), intent(inout)    :: desc_ac
-  integer(psb_ipk_), intent(out)           :: info
-
-  ! Local variables
-  integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, &
-       & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
-  integer(psb_ipk_)   :: inaggr
-  type(psb_ctxt_type) :: ictxt
-  integer(psb_ipk_)   :: np, me
-  character(len=20)   :: name
-  type(psb_lc_coo_sparse_mat) :: tmpcoo, ac_coo, lcoo_restr
-  type(psb_c_coo_sparse_mat)  :: coo_prol, coo_restr
-  type(psb_c_csr_sparse_mat)  :: acsrf, csr_prol, acsr, tcsr
-  real(psb_spk_), allocatable :: adiag(:)
-  real(psb_spk_), allocatable :: arwsum(:),l1rwsum(:)
-  logical            :: filter_mat
-  integer(psb_ipk_)            :: debug_level, debug_unit, err_act
-  integer(psb_ipk_), parameter :: ncmax=16
-  real(psb_spk_)     :: anorm, omega, tmp, dg, theta
-  logical, parameter :: debug_new=.false., dump_r=.false., dump_p=.false., debug=.false.
-  character(len=80) :: filename
-  logical, parameter :: do_timings=.false.
-  logical :: do_l1correction=.false.
-  integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1, idx_phase3=-1
-  integer(psb_ipk_), save :: idx_cdasb=-1, idx_ptap=-1
-
-  name='amg_parmatch_smth_bld'
-  info=psb_success_
-  call psb_erractionsave(err_act)
-  if (psb_errstatus_fatal()) then
-    info = psb_err_internal_error_; goto 9999
-  end if
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-  !debug_level = 2
-  ictxt = desc_a%get_context()
-
-  call psb_info(ictxt, me, np)
-
-  nglob = desc_a%get_global_rows()
-  nrow  = desc_a%get_local_rows()
-  ncol  = desc_a%get_local_cols()
-
-  theta = parms%aggr_thresh
-  ! Check if we have to perform l1-Jacobi or Jacobi as smoother
-  if(dol1smoothing.eq.amg_l1_smooth_prol_) do_l1correction=.true.
-
-
-  !write(0,*) me,' ',trim(name),' Start ',idx_spspmm
-  if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("PMC_SMTH_BLD: par_spspmm")
-  if ((do_timings).and.(idx_phase1==-1)) &
-       & idx_phase1 = psb_get_timer_idx("PMC_SMTH_BLD: phase1    ")
-  if ((do_timings).and.(idx_phase2==-1)) &
-       & idx_phase2 = psb_get_timer_idx("PMC_SMTH_BLD: phase2    ")
-  if ((do_timings).and.(idx_phase3==-1)) &
-       & idx_phase3 = psb_get_timer_idx("PMC_SMTH_BLD: phase3    ")
-  if ((do_timings).and.(idx_gtrans==-1)) &
-       & idx_gtrans = psb_get_timer_idx("PMC_SMTH_BLD: gtrans    ")
-  if ((do_timings).and.(idx_refine==-1)) &
-       & idx_refine = psb_get_timer_idx("PMC_SMTH_BLD: refine    ")
-  if ((do_timings).and.(idx_cdasb==-1)) &
-       & idx_cdasb = psb_get_timer_idx("PMC_SMTH_BLD: cdasb     ")
-  if ((do_timings).and.(idx_ptap==-1)) &
-       & idx_ptap = psb_get_timer_idx("PMC_SMTH_BLD: ptap_bld  ")
-
-  if (do_timings) call psb_tic(idx_phase1)
-
-  naggr  = nlaggr(me+1)
-  ntaggr = sum(nlaggr)
-  naggrm1 = sum(nlaggr(1:me))
-  naggrp1 = sum(nlaggr(1:me+1))
-  filter_mat = (parms%aggr_filter == amg_filter_mat_)
-
-  !
-  ! naggr: number of local aggregates
-  ! nrow: local rows.
-  !
-  if (dump_p) then
-    block
-      integer(psb_lpk_), allocatable :: ivr(:), ivc(:)
-      integer(psb_lpk_) :: i
-      character(len=132) :: aname
-      write(0,*) me,' ',trim(name),' Dumping inp_prol/restr'
-      write(aname,'(a,i0,a,i0,a)') 'tprol-',desc_a%get_global_rows(),'-p',me,'.mtx'
-      call t_prol%print(fname=aname,head='Test ')
-    end block
-  end if
-
-  if (do_timings)  call psb_tic(idx_refine)
-  ! Get the diagonal D
-  adiag = a%get_diag(info)
-  if (info == psb_success_) &
-       & call psb_realloc(ncol,adiag,info)
-  if (info == psb_success_) &
-       & call psb_halo(adiag,desc_a,info)
-  if (info == psb_success_) call a%cp_to(acsr)
-  ! Get the l1-diagonal of D
-  if (do_l1correction) then
-    allocate(l1rwsum(nrow))
-    call acsr%arwsum(l1rwsum)
-    if (info == psb_success_) &
-      & call psb_realloc(ncol,l1rwsum,info)
-    if (info == psb_success_) &
-      & call psb_halo(l1rwsum,desc_a,info)
-    ! \tilde{D}_{i,i} = \sum_{j \ne i} |a_{i,j}|
-    do i=1,size(adiag)
-      adiag(i) = adiag(i) + l1rwsum(i) - abs(adiag(i))
-    end do
-  end if
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
-    goto 9999
-  end if
-
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & ' Initial copies done.'
-
-  call acsr%cp_to_fmt(acsrf,info)
-
-  if (filter_mat) then
-    !
-    ! Build the filtered matrix Af from A
-    !
-
-    do i=1, nrow
-      tmp = dzero
-      jd  = -1
-      do j=acsrf%irp(i),acsrf%irp(i+1)-1
-        if (acsrf%ja(j) == i) jd = j
-        if (abs(acsrf%val(j)) < theta*sqrt(abs(adiag(i)*adiag(acsrf%ja(j))))) then
-          tmp=tmp+acsrf%val(j)
-          acsrf%val(j)=dzero
-        endif
-
-      enddo
-      if (jd == -1) then
-        write(0,*) name,': Warning: there is no diagonal element', i
-      else
-        acsrf%val(jd)=acsrf%val(jd)-tmp
-      end if
-    enddo
-    ! Take out zeroed terms
-    call acsrf%clean_zeros(info)
-  end if
-
-
-  do i=1,size(adiag)
-    if (adiag(i) /= dzero) then
-      adiag(i) = done / adiag(i)
-    else
-      adiag(i) = done
-    end if
-  end do
-  if (do_timings) call psb_toc(idx_refine)
-
-  if (parms%aggr_omega_alg == amg_eig_est_) then
-
-    if (do_l1correction) then
-      ! For l1-Jacobi this can be estimated with 1
-      parms%aggr_omega_val = done
-    else if (parms%aggr_eig == amg_max_norm_) then
-      allocate(arwsum(nrow))
-      call acsr%arwsum(arwsum)
-      anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow)))
-      call psb_amx(ictxt,anorm)
-      omega = 4.d0/(3.d0*anorm)
-      parms%aggr_omega_val = omega
-
-    else
-      info = psb_err_internal_error_
-      call psb_errpush(info,name,a_err='invalid amg_aggr_eig_')
-      goto 9999
-    end if
-
-  else if (parms%aggr_omega_alg == amg_user_choice_) then
-
-    omega = parms%aggr_omega_val
-
-  else if (parms%aggr_omega_alg /= amg_user_choice_) then
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='invalid amg_aggr_omega_alg_')
-    goto 9999
-  end if
-
-
-  call acsrf%scal(adiag,info)
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & ' Filtering and scaling  done.',info
-  if (info /= psb_success_) goto 9999
-
-  inaggr = naggr
-
-  call t_prol%cp_to(tmpcoo)
-
-  call psb_cdall(ictxt,desc_ac,info,nl=inaggr)
-  nzl = tmpcoo%get_nzeros()
-  call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzl),info)
-  call tmpcoo%set_ncols(desc_ac%get_local_cols())
-  call tmpcoo%mv_to_ifmt(tcsr,info)
-  !
-  ! Build the smoothed prolongator using either A or Af
-  !    csr_prol = (I-w*D*A) Prol      csr_prol = (I-w*D*Af) Prol
-  ! This is always done through the variable acsrf which
-  ! is a bit less readable, but saves space and one extra matrix copy
-  !
-  call omega_smooth(omega,acsrf)
-  if (do_timings) call psb_toc(idx_phase1)
-
-  if (do_timings) call psb_tic(idx_spspmm)
-  call psb_par_spspmm(acsrf,desc_a,tcsr,csr_prol,desc_ac,info)
-  call tcsr%free()
-  if (do_timings) call psb_toc(idx_spspmm)
-  if (do_timings) call psb_tic(idx_phase2)
-
-  if(info /= psb_success_) then
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
-    goto 9999
-  end if
-  !
-  ! Now that we have the smoothed prolongator, we can
-  ! compute the triple product.
-  !
-  if (do_timings)  call psb_tic(idx_cdasb)
-  call psb_cdasb(desc_ac,info)
-  if (do_timings)  call psb_toc(idx_cdasb)
-  call psb_cd_reinit(desc_ac,info)
-
-  call csr_prol%mv_to_coo(coo_prol,info)
-
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done SPSPMM 1'
-
-  if (do_timings)  call psb_tic(idx_ptap)
-  if (.not.allocated(ag%desc_ax)) allocate(ag%desc_ax)
-  call amg_ptap_bld(acsr,desc_a,nlaggr,parms,ac,&
-       & coo_prol,desc_ac,coo_restr,info,desc_ax=ag%desc_ax)
-  if (do_timings)  call psb_toc(idx_ptap)
-
-  call op_prol%mv_from(coo_prol)
-  call op_restr%mv_from(coo_restr)
-
-
-  if (debug) write(0,*)  me,' ',trim(name),' After  mv_from',psb_get_errstatus()
-  if (debug) write(0,*)  me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
-
-  if (dump_r) then
-    block
-      integer(psb_lpk_), allocatable :: ivr(:), ivc(:)
-      integer(psb_lpk_) :: i
-      character(len=132) :: aname
-      type(psb_lcspmat_type) :: aglob
-      type(psb_cspmat_type) :: atmp
-      write(0,*) me,' ',trim(name),' Dumping prol/restr'
-      ivc    = [(i,i=1,desc_a%get_local_cols())]
-      call desc_a%l2gip(ivc,info)
-      ivr    = [(i,i=1,desc_ac%get_local_cols())]
-      call desc_ac%l2gip(ivr,info)
-
-      write(aname,'(a,i0,a,i0,a)') 'restr-',desc_ac%get_global_rows(),'-p',me,'.mtx'
-
-      call op_restr%print(fname=aname,head='Test ',ivc=ivc)
-
-    end block
-  end if
-  if (allocated(l1rwsum)) deallocate(l1rwsum)
-  if (do_timings) call psb_toc(idx_phase2)
-
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done smooth_aggregate '
-
-  call psb_erractionrestore(err_act)
-  return
-
-9999 continue
-  call psb_errpush(info,name)
-  call psb_error_handler(err_act)
-  return
-
-contains
-
-  subroutine omega_smooth(omega,acsr)
-    implicit none
-    real(psb_spk_),intent(in) :: omega
-    type(psb_c_csr_sparse_mat), intent(inout) :: acsr
-    !
-    integer(psb_ipk_) :: i,j
-    do i=1,acsr%get_nrows()
-      do j=acsr%irp(i),acsr%irp(i+1)-1
-        if (acsr%ja(j) == i) then
-          acsr%val(j) = done - omega*acsr%val(j)
-        else
-          acsr%val(j) = - omega*acsr%val(j)
-        end if
-      end do
-    end do
-  end subroutine omega_smooth
-
-end subroutine amg_c_parmatch_smth_bld

amgprec/impl/aggregator/amg_c_parmatch_spmm_bld.F90

@@ -1,160 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-! File: amg_caggrmat_nosmth_bld.F90
-!
-! Subroutine: amg_caggrmat_nosmth_bld
-! Version:    real
-!
-!  This routine builds a coarse-level matrix A_C from a fine-level matrix A
-!  by using the Galerkin approach, i.e.
-!
-!                               A_C = P_C^T A P_C,
-!
-!  where P_C is the piecewise constant interpolation operator corresponding
-!  the fine-to-coarse level mapping built by amg_aggrmap_bld.
-!
-!  The coarse-level matrix A_C is distributed among the parallel processes or
-!  replicated on each of them, according to the value of p%parms%coarse_mat
-!  specified by the user through amg_cprecinit and amg_zprecset.
-!  On output from this routine the entries of AC, op_prol, op_restr
-!  are still in "global numbering" mode; this is fixed in the calling routine
-!
-!  For details see
-!    P. D'Ambra, D. di Serafino and  S. Filippone, On the development of
-!    PSBLAS-based parallel two-level Schwarz preconditioners, Appl. Num. Math.,
-!    57 (2007), 1181-1196.
-!
-!
-! Arguments:
-!    a          -  type(psb_cspmat_type), input.
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!    p          -  type(amg_c_onelev_type), input/output.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!    parms      -   type(amg_cml_parms), input
-!                  Parameters controlling the choice of algorithm
-!    ac         -  type(psb_cspmat_type), output
-!                  The coarse matrix on output
-!
-!    ilaggr     -  integer, dimension(:), input
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that the indices
-!                  are assumed to be shifted so as to make sure the ranges on
-!                  the various processes do not   overlap.
-!    nlaggr     -  integer, dimension(:) input
-!                  nlaggr(i) contains the aggregates held by process i.
-!    op_prol    -  type(psb_cspmat_type), input/output
-!                  The tentative prolongator on input, the computed prolongator on output
-!
-!    op_restr    -  type(psb_cspmat_type), output
-!                  The restrictor operator; normally, it is the transpose of the prolongator.
-!
-!    info       -  integer, output.
-!                  Error code.
-!
-!
-subroutine amg_c_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
-  use psb_base_mod
-  use amg_c_inner_mod
-  use amg_c_parmatch_aggregator_mod, amg_protect_name => amg_c_parmatch_spmm_bld
-  implicit none
-
-  ! Arguments
-  type(psb_cspmat_type), intent(in)       :: a
-  type(psb_desc_type), intent(inout)       :: desc_a
-  integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-  type(amg_cml_parms), intent(inout)      :: parms
-  type(psb_lcspmat_type), intent(inout)   :: t_prol
-  type(psb_cspmat_type), intent(inout)    :: ac, op_prol, op_restr
-  type(psb_desc_type), intent(out)        :: desc_ac
-  integer(psb_ipk_), intent(out)          :: info
-
-  ! Local variables
-  integer(psb_ipk_)  :: err_act
-
-  type(psb_ctxt_type) :: ictxt
-  integer(psb_ipk_)   :: np,me
-  character(len=20)   :: name
-  type(psb_c_csr_sparse_mat) :: acsr
-  integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
-       & naggr, nzt, naggrm1, naggrp1, i, k
-  integer(psb_ipk_) :: inaggr, nzlp
-  integer(psb_ipk_) :: debug_level, debug_unit
-  logical, parameter :: debug=.false.
-
-  name='amg_parmatch_spmm_bld'
-  if(psb_get_errstatus().ne.0) return
-  info=psb_success_
-  call psb_erractionsave(err_act)
-
-
-  ictxt = desc_a%get_context()
-  call psb_info(ictxt, me, np)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-
-  call a%cp_to(acsr)
-
-  call  amg_c_parmatch_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,&
-       & ac,desc_ac,op_prol,op_restr,t_prol,info)
-  if (info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    call psb_errpush(info,name,a_err="SPMM_BLD_INNER")
-    goto 9999
-  end if
-
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done spmm_bld '
-
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-
-  return
-
-end subroutine amg_c_parmatch_spmm_bld

amgprec/impl/aggregator/amg_c_parmatch_spmm_bld_inner.F90

@@ -1,211 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-! File: amg_caggrmat_nosmth_bld.F90
-!
-! Subroutine: amg_caggrmat_nosmth_bld
-! Version:    real
-!
-!  This routine builds a coarse-level matrix A_C from a fine-level matrix A
-!  by using the Galerkin approach, i.e.
-!
-!                               A_C = P_C^T A P_C,
-!
-!  where P_C is the piecewise constant interpolation operator corresponding
-!  the fine-to-coarse level mapping built by amg_aggrmap_bld.
-!
-!  The coarse-level matrix A_C is distributed among the parallel processes or
-!  replicated on each of them, according to the value of p%parms%coarse_mat
-!  specified by the user through amg_cprecinit and amg_zprecset.
-!  On output from this routine the entries of AC, op_prol, op_restr
-!  are still in "global numbering" mode; this is fixed in the calling routine
-!
-!  For details see
-!    P. D'Ambra, D. di Serafino and  S. Filippone, On the development of
-!    PSBLAS-based parallel two-level Schwarz preconditioners, Appl. Num. Math.,
-!    57 (2007), 1181-1196.
-!
-!
-! Arguments:
-!    a          -  type(psb_cspmat_type), input.
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!    p          -  type(amg_c_onelev_type), input/output.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!    parms      -   type(amg_cml_parms), input
-!                  Parameters controlling the choice of algorithm
-!    ac         -  type(psb_cspmat_type), output
-!                  The coarse matrix on output
-!
-!    ilaggr     -  integer, dimension(:), input
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that the indices
-!                  are assumed to be shifted so as to make sure the ranges on
-!                  the various processes do not   overlap.
-!    nlaggr     -  integer, dimension(:) input
-!                  nlaggr(i) contains the aggregates held by process i.
-!    op_prol    -  type(psb_cspmat_type), input/output
-!                  The tentative prolongator on input, the computed prolongator on output
-!
-!    op_restr    -  type(psb_cspmat_type), output
-!                  The restrictor operator; normally, it is the transpose of the prolongator.
-!
-!    info       -  integer, output.
-!                  Error code.
-!
-!
-subroutine amg_c_parmatch_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
-  use psb_base_mod
-  use amg_c_inner_mod
-  use amg_c_parmatch_aggregator_mod, amg_protect_name => amg_c_parmatch_spmm_bld_inner
-  implicit none
-
-  ! Arguments
-  type(psb_c_csr_sparse_mat), intent(inout) :: a_csr
-  type(psb_desc_type), intent(inout)          :: desc_a
-  integer(psb_lpk_), intent(inout)          :: ilaggr(:), nlaggr(:)
-  type(amg_sml_parms), intent(inout)        :: parms
-  type(psb_lcspmat_type), intent(inout)     :: t_prol
-  type(psb_cspmat_type), intent(inout)      :: ac, op_prol, op_restr
-  type(psb_desc_type), intent(out)          :: desc_ac
-  integer(psb_ipk_), intent(out)            :: info
-
-  ! Local variables
-  integer(psb_ipk_)   :: err_act
-  type(psb_ctxt_type) :: ictxt
-  integer(psb_ipk_)   :: np, me, ndx
-  character(len=40)   :: name
-  type(psb_lc_coo_sparse_mat) :: tmpcoo
-  type(psb_c_coo_sparse_mat)  :: coo_prol, coo_restr
-  type(psb_c_csr_sparse_mat)  :: ac_csr, csr_restr
-  type(psb_desc_type), target  :: tmp_desc
-  type(psb_lcspmat_type)     :: lac
-  integer(psb_ipk_) :: debug_level, debug_unit, naggr
-  integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nrl, nzl, ip, &
-       &  nzt, naggrm1, naggrp1, i, k
-  integer(psb_lpk_), allocatable :: ia(:),ja(:)
-  !integer(psb_lpk_) ::  nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave
-  logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
-  integer(psb_ipk_), save :: idx_spspmm=-1, idx_prolcnv=-1, idx_proltrans=-1, idx_asb=-1
-
-  name='amg_parmatch_spmm_bld_inner'
-  if(psb_get_errstatus().ne.0) return
-  info=psb_success_
-  call psb_erractionsave(err_act)
-
-  ictxt = desc_a%get_context()
-  call psb_info(ictxt, me, np)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-  nglob = desc_a%get_global_rows()
-  nrow  = desc_a%get_local_rows()
-  ncol  = desc_a%get_local_cols()
-
-  if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("SPMM_BLD: spspmm   ")
-  if ((do_timings).and.(idx_prolcnv==-1)) &
-       & idx_prolcnv = psb_get_timer_idx("SPMM_BLD: prolcnv  ")
-  if ((do_timings).and.(idx_proltrans==-1)) &
-       & idx_proltrans = psb_get_timer_idx("SPMM_BLD: proltrans")
-  if ((do_timings).and.(idx_asb==-1)) &
-       & idx_asb = psb_get_timer_idx("SPMM_BLD: asb      ")
-
-  if (do_timings) call psb_tic(idx_prolcnv)
-  naggr   = nlaggr(me+1)
-  ntaggr  = sum(nlaggr)
-  naggrm1 = sum(nlaggr(1:me))
-  naggrp1 = sum(nlaggr(1:me+1))
-
-  !
-  ! Here T_PROL should be arriving with GLOBAL indices on the cols
-  ! and LOCAL indices on the rows.
-  !
-  if (debug) write(0,*)  me,' ',trim(name),' Size check on entry New: ',&
-       & op_prol%get_fmt(),op_prol%get_nrows(),op_prol%get_ncols(),op_prol%get_nzeros(),&
-       & nrow,ntaggr,naggr
-
-  call t_prol%cp_to(tmpcoo)
-
-  call psb_cdall(ictxt,desc_ac,info,nl=naggr)
-  nzl = tmpcoo%get_nzeros()
-  if (debug) write(0,*)  me,' ',trim(name),' coo_prol: ',&
-       & tmpcoo%ia(1:min(10,nzl)),' :',tmpcoo%ja(1:min(10,nzl))
-  call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzl),info)
-  call tmpcoo%set_ncols(desc_ac%get_local_cols())
-  call tmpcoo%cp_to_icoo(coo_prol,info)
-
-  call amg_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
-       & coo_prol,desc_ac,coo_restr,info)
-
-  nzl = coo_prol%get_nzeros()
-  if (debug) write(0,*)  me,' ',trim(name),' coo_prol: ',&
-       & coo_prol%ia(1:min(10,nzl)),' :',coo_prol%ja(1:min(10,nzl))
-
-  call op_prol%mv_from(coo_prol)
-  call op_restr%mv_from(coo_restr)
-
-  if (debug) then
-    write(0,*) me,' ',trim(name),' Checkpoint at exit'
-    call psb_barrier(ictxt)
-    write(0,*) me,' ',trim(name),' Checkpoint through'
-  end if
-
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x a3')
-    goto 9999
-  end if
-
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done smooth_aggregate '
-
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-
-  return
-
-end subroutine amg_c_parmatch_spmm_bld_inner

amgprec/impl/aggregator/amg_c_parmatch_spmm_bld_ov.F90

@@ -1,162 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-! File: amg_caggrmat_nosmth_bld_ov.F90
-!
-! Subroutine: amg_caggrmat_nosmth_bld_ov
-! Version:    real
-!
-!  This routine builds a coarse-level matrix A_C from a fine-level matrix A
-!  by using the Galerkin approach, i.e.
-!
-!                               A_C = P_C^T A P_C,
-!
-!  where P_C is the piecewise constant interpolation operator corresponding
-!  the fine-to-coarse level mapping built by amg_aggrmap_bld_ov.
-!
-!  The coarse-level matrix A_C is distributed among the parallel processes or
-!  replicated on each of them, according to the value of p%parms%coarse_mat
-!  specified by the user through amg_cprecinit and amg_zprecset.
-!  On output from this routine the entries of AC, op_prol, op_restr
-!  are still in "global numbering" mode; this is fixed in the calling routine
-!
-!  For details see
-!    P. D'Ambra, D. di Serafino and  S. Filippone, On the development of
-!    PSBLAS-based parallel two-level Schwarz preconditioners, Appl. Num. Math.,
-!    57 (2007), 1181-1196.
-!
-!
-! Arguments:
-!    a          -  type(psb_cspmat_type), input.
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!    p          -  type(amg_c_onelev_type), input/output.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!    parms      -   type(amg_cml_parms), input
-!                  Parameters controlling the choice of algorithm
-!    ac         -  type(psb_cspmat_type), output
-!                  The coarse matrix on output
-!
-!    ilaggr     -  integer, dimension(:), input
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that the indices
-!                  are assumed to be shifted so as to make sure the ranges on
-!                  the various processes do not   overlap.
-!    nlaggr     -  integer, dimension(:) input
-!                  nlaggr(i) contains the aggregates held by process i.
-!    op_prol    -  type(psb_cspmat_type), input/output
-!                  The tentative prolongator on input, the computed prolongator on output
-!
-!    op_restr    -  type(psb_cspmat_type), output
-!                  The restrictor operator; normally, it is the transpose of the prolongator.
-!
-!    info       -  integer, output.
-!                  Error code.
-!
-!
-subroutine amg_c_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
-     & ac,desc_ac,op_prol,op_restr,t_prol,info)
-  use psb_base_mod
-  use amg_c_inner_mod
-  use amg_c_parmatch_aggregator_mod, amg_protect_name => amg_c_parmatch_spmm_bld_ov
-  implicit none
-
-  ! Arguments
-  type(psb_cspmat_type), intent(inout)    :: a
-  type(psb_desc_type), intent(inout)       :: desc_a
-  integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
-  type(amg_sml_parms), intent(inout)      :: parms
-  type(psb_lcspmat_type), intent(inout)   :: t_prol
-  type(psb_cspmat_type), intent(inout)      :: ac, op_prol, op_restr
-  type(psb_desc_type), intent(out)        :: desc_ac
-  integer(psb_ipk_), intent(out)          :: info
-
-  ! Local variables
-  integer(psb_ipk_)  :: err_act
-
-  type(psb_ctxt_type) :: ictxt
-  integer(psb_ipk_)   :: np, me
-  character(len=20)   :: name
-  type(psb_c_csr_sparse_mat) :: acsr
-  type(psb_lc_coo_sparse_mat) :: coo_prol, coo_restr
-  integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
-       & naggr, nzt, naggrm1, naggrp1, i, k
-  integer(psb_ipk_) :: inaggr, nzlp
-  integer(psb_ipk_) :: debug_level, debug_unit
-  logical, parameter :: debug=.false., new_version=.true.
-
-  name='amg_parmatch_spmm_bld_ov'
-  if(psb_get_errstatus().ne.0) return
-  info=psb_success_
-  call psb_erractionsave(err_act)
-
-
-  ictxt = desc_a%get_context()
-  call psb_info(ictxt, me, np)
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-
-  call a%mv_to(acsr)
-
-  call  amg_c_parmatch_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,&
-       & ac,desc_ac,op_prol,op_restr,t_prol,info)
-  if (psb_errstatus_fatal())  write(0,*)me,trim(name),'Error fatal on exit from bld_inner',info
-
-  if (info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    call psb_errpush(info,name,a_err="SPMM_BLD_INNER")
-    goto 9999
-  end if
-
-  if (debug_level >= psb_debug_outer_) &
-       & write(debug_unit,*) me,' ',trim(name),&
-       & 'Done spmm_bld '
-  call psb_erractionrestore(err_act)
-  return
-
-9999 call psb_error_handler(err_act)
-
-  return
-
-end subroutine amg_c_parmatch_spmm_bld_ov

amgprec/impl/aggregator/amg_c_parmatch_unsmth_bld.F90

@@ -1,258 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Fabio Durastante
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-! File: amg_c_parmatch_unsmth_bld.F90
-!
-! Subroutine: amg_c_parmatch_unsmth_bld
-! Version:    real
-!
-!  This routine builds a coarse-level matrix A_C from a fine-level matrix A
-!  by using the Galerkin approach, i.e.
-!
-!                               A_C = P_C^T A P_C,
-!
-!  where P_C is a prolongator from the coarse level to the fine one.
-!
-!  The prolongator P_C is built according to a smoothed aggregation algorithm,
-!  i.e. it is obtained by applying a damped Jacobi smoother to the piecewise
-!  constant interpolation operator P corresponding to the fine-to-coarse level
-!  mapping built by the amg_aggrmap_bld subroutine:
-!
-!                            P_C = (I - omega*D^(-1)A) * P,
-!
-!  where D is the diagonal matrix with main diagonal equal to the main diagonal
-!  of A, and omega is a suitable smoothing parameter. An estimate of the spectral
-!  radius of D^(-1)A, to be used in the computation of omega, is provided,
-!  according to the value of p%parms%aggr_omega_alg, specified by the user
-!  through amg_cprecinit and amg_zprecset.
-!
-!  The coarse-level matrix A_C is distributed among the parallel processes or
-!  replicated on each of them, according to the value of p%parms%coarse_mat,
-!  specified by the user through amg_cprecinit and amg_zprecset.
-!  On output from this routine the entries of AC, op_prol, op_restr
-!  are still in "global numbering" mode; this is fixed in the calling routine
-!  aggregator%mat_bld.
-!
-!
-! Arguments:
-!    dol1smoothing - this not actually used inside unsmoothed aggregation, it
-!                  is used just to perform a check
-!    a          -  type(psb_cspmat_type), input.
-!                  The sparse matrix structure containing the local part of
-!                  the fine-level matrix.
-!    desc_a     -  type(psb_desc_type), input.
-!                  The communication descriptor of the fine-level matrix.
-!    p          -  type(amg_c_onelev_type), input/output.
-!                  The 'one-level' data structure that will contain the local
-!                  part of the matrix to be built as well as the information
-!                  concerning the prolongator and its transpose.
-!    parms      -   type(amg_cml_parms), input
-!                  Parameters controlling the choice of algorithm
-!    ac         -  type(psb_cspmat_type), output
-!                  The coarse matrix on output
-!
-!    ilaggr     -  integer, dimension(:), input
-!                  The mapping between the row indices of the coarse-level
-!                  matrix and the row indices of the fine-level matrix.
-!                  ilaggr(i)=j means that node i in the adjacency graph
-!                  of the fine-level matrix is mapped onto node j in the
-!                  adjacency graph of the coarse-level matrix. Note that the indices
-!                  are assumed to be shifted so as to make sure the ranges on
-!                  the various processes do not   overlap.
-!    nlaggr     -  integer, dimension(:) input
-!                  nlaggr(i) contains the aggregates held by process i.
-!    op_prol    -  type(psb_cspmat_type), input/output
-!                  The tentative prolongator on input, the computed prolongator on output
-!
-!    op_restr    -  type(psb_cspmat_type), output
-!                  The restrictor operator; normally, it is the transpose of the prolongator.
-!
-!    info       -  integer, output.
-!                  Error code.
-!
-subroutine amg_c_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
-  use psb_base_mod
-  use amg_base_prec_type
-  use amg_c_inner_mod
-  use amg_c_base_aggregator_mod
-  use amg_c_parmatch_aggregator_mod, amg_protect_name => amg_c_parmatch_unsmth_bld
-  implicit none
-
-  ! Arguments
-  integer(psb_ipk_), intent(in) :: dol1smoothing
-  class(amg_c_parmatch_aggregator_type), target, intent(inout) :: ag
-  type(psb_cspmat_type), intent(in)      :: a
-  type(psb_desc_type), intent(inout)     :: desc_a
-  integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
-  type(amg_cml_parms), intent(inout)    :: parms
-  type(psb_cspmat_type), intent(inout)    :: op_prol,ac,op_restr
-  type(psb_lcspmat_type), intent(inout)  :: t_prol
-  type(psb_desc_type), intent(inout)       :: desc_ac
-  integer(psb_ipk_), intent(out)           :: info
-
-  ! Local variables
-  integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, &
-       & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
-  integer(psb_ipk_) :: inaggr
-  type(psb_ctxt_type) :: ictxt
-  integer(psb_ipk_)   :: np, me
-  character(len=20)   :: name
-  type(psb_lc_coo_sparse_mat) :: lcoo_prol
-  type(psb_c_coo_sparse_mat) :: coo_prol, coo_restr
-  type(psb_c_csr_sparse_mat) :: acsr
-  type(psb_c_csr_sparse_mat)  :: csr_prol, acsr3, csr_restr, ac_csr
-  real(psb_spk_), allocatable :: adiag(:)
-  real(psb_spk_), allocatable :: arwsum(:)
-  logical            :: filter_mat
-  integer(psb_ipk_)            :: debug_level, debug_unit, err_act
-  integer(psb_ipk_), parameter :: ncmax=16
-  real(psb_spk_)   :: anorm, omega, tmp, dg, theta
-  logical, parameter :: debug_new=.false., dump_r=.false., dump_p=.false., debug=.false.
-  logical, parameter :: do_timings=.false.
-  integer(psb_ipk_), save :: idx_spspmm=-1
-  character(len=80) :: filename
-
-  name='amg_parmatch_unsmth_bld'
-  info=psb_success_
-  call psb_erractionsave(err_act)
-  if (psb_errstatus_fatal()) then
-    info = psb_err_internal_error_; goto 9999
-  end if
-  debug_unit  = psb_get_debug_unit()
-  debug_level = psb_get_debug_level()
-
-  ictxt = desc_a%get_context()
-
-  call psb_info(ictxt, me, np)
-  if (dol1smoothing.ne.amg_no_smooth_) then
-    info=psb_err_fatal_;         
-    call psb_errpush(info,name,a_err='Are you trying to smooth an unsmoothed aggregation?')
-    goto 9999
-  end if
-
-  nglob = desc_a%get_global_rows()
-  nrow  = desc_a%get_local_rows()
-  ncol  = desc_a%get_local_cols()
-
-  theta = parms%aggr_thresh
-  !write(0,*) me,' ',trim(name),' Start '
-
-  if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("PMC_UNSMTH_BLD: par_spspmm")
-
-  !
-  naggr   = nlaggr(me+1)
-  ntaggr  = sum(nlaggr)
-  naggrm1 = sum(nlaggr(1:me))
-  naggrp1 = sum(nlaggr(1:me+1))
-  !write(0,*) me,' ',trim(name),' input sizes',nlaggr(:),':',naggr
-
-  call a%cp_to(acsr)
-  call t_prol%mv_to(lcoo_prol)
-
-  inaggr = naggr
-  call psb_cdall(ictxt,desc_ac,info,nl=inaggr)
-  nzl = lcoo_prol%get_nzeros()
-  call desc_ac%indxmap%g2lip_ins(lcoo_prol%ja(1:nzl),info)
-  call lcoo_prol%set_ncols(desc_ac%get_local_cols())
-  call lcoo_prol%cp_to_icoo(coo_prol,info)
-
-  if (debug) call check_coo(me,trim(name)//' Check 1 on  coo_prol:',coo_prol)
-
-  call psb_cdasb(desc_ac,info)
-  call psb_cd_reinit(desc_ac,info)
-  if (.not.allocated(ag%desc_ax)) allocate(ag%desc_ax)
-
-  call amg_ptap_bld(acsr,desc_a,nlaggr,parms,ac,&
-       & coo_prol,desc_ac,coo_restr,info,desc_ax=ag%desc_ax)
-
-  call op_restr%cp_from(coo_restr)
-  call op_prol%mv_from(coo_prol)
-
-  if (debug) write(0,*)  me,' ',trim(name),' After  mv_from',psb_get_errstatus()
-  if (debug) write(0,*)  me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),&
-       & ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
-  ! write(0,*)  me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
-
-  if (debug) then
-    write(0,*) me,' ',trim(name),' Checkpoint at exit'
-    call psb_barrier(ictxt)
-    write(0,*) me,' ',trim(name),' Checkpoint through'
-    block
-      character(len=128) :: fname, prefix_
-      integer :: lname
-      prefix_ = "unsmth_bld_"
-      lname = len_trim(prefix_)
-      fname = trim(prefix_)
-      write(fname(lname+1:lname+10),'(a,i3.3,a)') '_p_',me, '.mtx'
-      call op_prol%print(fname,head='Debug aggregates')
-      write(fname(lname+1:lname+10),'(a,i3.3,a)') '_r_',me, '.mtx'
-      call op_restr%print(fname,head='Debug aggregates')
-      write(fname(lname+1:lname+11),'(a,i3.3,a)') '_ac_',me, '.mtx'
-      call ac%print(fname,head='Debug aggregates')
-    end block
-  end if
-
-  if (info /= psb_success_) then
-    call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = coo_restr x am3')
-    goto 9999
-  end if
-
-  call psb_erractionrestore(err_act)
-  return
-
-9999 continue
-  call psb_errpush(info,name)
-  call psb_error_handler(err_act)
-  return
-
-contains
-  subroutine check_coo(me,string,coo)
-    implicit none
-    integer(psb_ipk_) :: me
-    type(psb_c_coo_sparse_mat) :: coo
-    character(len=*) :: string
-    integer(psb_lpk_) :: nr,nc,nz
-    nr = coo%get_nrows()
-    nc = coo%get_ncols()
-    nz = coo%get_nzeros()
-    write(0,*) me,string,nr,nc,&
-         & minval(coo%ia(1:nz)),maxval(coo%ia(1:nz)),&
-         & minval(coo%ja(1:nz)),maxval(coo%ja(1:nz))
-  end subroutine check_coo
-
-end subroutine amg_c_parmatch_unsmth_bld

amgprec/impl/aggregator/amg_d_dec_aggregator_mat_asb.f90

@@ -114,63 +114,67 @@ subroutine  amg_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
+  
+  if (me >=0) then 
+    select case(parms%coarse_mat)
 
-  select case(parms%coarse_mat)
+    case(amg_distr_mat_) 
 
-  case(amg_distr_mat_) 
+      call ac%cscnv(info,type='csr')
+      call op_prol%cscnv(info,type='csr')
+      call op_restr%cscnv(info,type='csr')
 
-    call ac%cscnv(info,type='csr')
-    call op_prol%cscnv(info,type='csr')
-    call op_restr%cscnv(info,type='csr')
+      if (debug_level >= psb_debug_outer_) &
+           & write(debug_unit,*) me,' ',trim(name),&
+           & 'Done ac '
 
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done ac '
+    case(amg_repl_mat_) 
+      !
+      ! We are assuming here that an d matrix
+      ! can hold all entries
+      !
+      if (desc_ac%get_global_rows() < huge(1_psb_ipk_) ) then 
+        ntaggr = desc_ac%get_global_rows()
+        i_nr   = ntaggr
+      else
+        info = psb_err_internal_error_
+        call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
+        goto 9999
+      end if
 
-  case(amg_repl_mat_) 
-    !
-    ! We are assuming here that an d matrix
-    ! can hold all entries
-    !
-    if (desc_ac%get_global_rows() < huge(1_psb_ipk_) ) then 
-      ntaggr = desc_ac%get_global_rows()
-      i_nr   = ntaggr
-    else
+      call op_prol%mv_to(tmpcoo)
+      nzl = tmpcoo%get_nzeros()
+      call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
+      call tmpcoo%set_ncols(i_nr)
+      call op_prol%mv_from(tmpcoo)
+
+      call op_restr%mv_to(tmpcoo)
+      nzl = tmpcoo%get_nzeros()
+      call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
+      call tmpcoo%set_nrows(i_nr)
+      call op_restr%mv_from(tmpcoo)
+
+
+      call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
+           & dupl=psb_dupl_add_,keeploc=.false.)
+      call tmp_ac%mv_to(tmpcoo)
+      call ac%mv_from(tmpcoo)
+
+      call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
+      if (info == psb_success_) call psb_cdasb(desc_ac,info)
+
+      if (info /= psb_success_) goto 9999
+
+    case default 
       info = psb_err_internal_error_
       call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
       goto 9999
-    end if
-    
-    call op_prol%mv_to(tmpcoo)
-    nzl = tmpcoo%get_nzeros()
-    call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
-    call tmpcoo%set_ncols(i_nr)
-    call op_prol%mv_from(tmpcoo)
-
-    call op_restr%mv_to(tmpcoo)
-    nzl = tmpcoo%get_nzeros()
-    call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
-    call tmpcoo%set_nrows(i_nr)
-    call op_restr%mv_from(tmpcoo)
-
-
-    call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
-         & dupl=psb_dupl_add_,keeploc=.false.)
-    call tmp_ac%mv_to(tmpcoo)
-    call ac%mv_from(tmpcoo)
-    
-    call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
-    if (info == psb_success_) call psb_cdasb(desc_ac,info)
-
-    if (info /= psb_success_) goto 9999
-
-  case default 
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
-    goto 9999
-  end select
-
-
+    end select
+  else
+    call op_prol%allocate(izero,izero,info)
+    call op_restr%allocate(izero,izero,info)
+    call ac%allocate(izero,izero,info)
+  end if
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_d_dec_aggregator_mat_bld.f90

@@ -139,7 +139,7 @@ subroutine  amg_d_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   use amg_d_prec_type, amg_protect_name => amg_d_dec_aggregator_mat_bld
   use amg_d_inner_mod 
   implicit none
-  
+
   class(amg_d_dec_aggregator_type), target, intent(inout) :: ag
   type(amg_dml_parms), intent(inout)      :: parms 
   type(psb_dspmat_type), intent(in)    :: a
@@ -169,39 +169,46 @@ subroutine  amg_d_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
 
-  !
-  ! Build the coarse-level matrix from the fine-level one, starting from 
-  ! the mapping defined by amg_aggrmap_bld and applying the aggregation
-  ! algorithm specified by 
-  !
-  select case (parms%aggr_prol)
-  case (amg_no_smooth_) 
+  if (me >=0) then 
+    !
+    ! Build the coarse-level matrix from the fine-level one, starting from 
+    ! the mapping defined by amg_aggrmap_bld and applying the aggregation
+    ! algorithm specified by 
+    !
+    select case (parms%aggr_prol)
+    case (amg_no_smooth_) 
 
-    call amg_daggrmat_nosmth_bld(parms%aggr_prol,a,desc_a,ilaggr,&
-            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+      call amg_daggrmat_nosmth_bld(parms%aggr_prol,a,desc_a,ilaggr,&
+           nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
-  case(amg_smooth_prol_,amg_l1_smooth_prol_) 
+    case(amg_smooth_prol_,amg_l1_smooth_prol_) 
 
-    call amg_daggrmat_smth_bld(parms%aggr_prol,a,desc_a,&
-            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,&
-            op_restr,t_prol,info)
+      call amg_daggrmat_smth_bld(parms%aggr_prol,a,desc_a,&
+           ilaggr,nlaggr,parms,ac,desc_ac,op_prol,&
+           op_restr,t_prol,info)
 
 !!$  case(amg_biz_prol_) 
 !!$
 !!$    call amg_daggrmat_biz_bld(a,desc_a,ilaggr,nlaggr, &
 !!$         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
-  
-  case(amg_min_energy_) 
 
-    call amg_daggrmat_minnrg_bld(parms%aggr_prol,a,desc_a,ilaggr,&
-            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    case(amg_min_energy_) 
 
-  case default
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='Invalid aggr kind')
-    goto 9999
+      call amg_daggrmat_minnrg_bld(parms%aggr_prol,a,desc_a,ilaggr,&
+           nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+
+    case default
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,a_err='Invalid aggr kind')
+      goto 9999
+
+    end select
+  else
+    call op_prol%allocate(izero,izero,info)
+    call op_restr%allocate(izero,izero,info)
+    call ac%allocate(izero,izero,info)
+  end if
 
-  end select
   if (info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner aggrmat bld')
     goto 9999
@@ -214,5 +221,5 @@ subroutine  amg_d_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
 9999 call psb_error_handler(err_act)
   return
 
-  
+
 end subroutine amg_d_dec_aggregator_mat_bld

amgprec/impl/aggregator/amg_d_dec_aggregator_tprol.f90

@@ -122,19 +122,23 @@ subroutine  amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
   call amg_check_def(parms%aggr_ord,'Ordering',&
        &   amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
   call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
+  if (me >=0) then 
+    !
+    ! The decoupled aggregator based on SOC measures ignores
+    ! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
+    !
+    if (do_timings) call psb_tic(idx_map_bld)
+    clean_zeros = ag%do_clean_zeros
+    call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
+    if (do_timings) call psb_toc(idx_map_bld)
+    if (do_timings) call psb_tic(idx_map_tprol)
 
-  !
-  ! The decoupled aggregator based on SOC measures ignores
-  ! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
-  !
-  if (do_timings) call psb_tic(idx_map_bld)
-  clean_zeros = ag%do_clean_zeros
-  call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
-  if (do_timings) call psb_toc(idx_map_bld)
-  if (do_timings) call psb_tic(idx_map_tprol)
-
-  if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
-  if (do_timings) call psb_toc(idx_map_tprol)
+    if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
+    if (do_timings) call psb_toc(idx_map_tprol)
+  else
+    allocate(nlaggr(0),ilaggr(0))
+    call t_prol%allocate(lzero,lzero,info)
+  end if
   if (info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

amgprec/impl/aggregator/amg_s_dec_aggregator_mat_asb.f90

@@ -114,63 +114,67 @@ subroutine  amg_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
+  
+  if (me >=0) then 
+    select case(parms%coarse_mat)
 
-  select case(parms%coarse_mat)
+    case(amg_distr_mat_) 
 
-  case(amg_distr_mat_) 
+      call ac%cscnv(info,type='csr')
+      call op_prol%cscnv(info,type='csr')
+      call op_restr%cscnv(info,type='csr')
 
-    call ac%cscnv(info,type='csr')
-    call op_prol%cscnv(info,type='csr')
-    call op_restr%cscnv(info,type='csr')
+      if (debug_level >= psb_debug_outer_) &
+           & write(debug_unit,*) me,' ',trim(name),&
+           & 'Done ac '
 
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done ac '
+    case(amg_repl_mat_) 
+      !
+      ! We are assuming here that an s matrix
+      ! can hold all entries
+      !
+      if (desc_ac%get_global_rows() < huge(1_psb_ipk_) ) then 
+        ntaggr = desc_ac%get_global_rows()
+        i_nr   = ntaggr
+      else
+        info = psb_err_internal_error_
+        call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
+        goto 9999
+      end if
 
-  case(amg_repl_mat_) 
-    !
-    ! We are assuming here that an s matrix
-    ! can hold all entries
-    !
-    if (desc_ac%get_global_rows() < huge(1_psb_ipk_) ) then 
-      ntaggr = desc_ac%get_global_rows()
-      i_nr   = ntaggr
-    else
+      call op_prol%mv_to(tmpcoo)
+      nzl = tmpcoo%get_nzeros()
+      call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
+      call tmpcoo%set_ncols(i_nr)
+      call op_prol%mv_from(tmpcoo)
+
+      call op_restr%mv_to(tmpcoo)
+      nzl = tmpcoo%get_nzeros()
+      call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
+      call tmpcoo%set_nrows(i_nr)
+      call op_restr%mv_from(tmpcoo)
+
+
+      call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
+           & dupl=psb_dupl_add_,keeploc=.false.)
+      call tmp_ac%mv_to(tmpcoo)
+      call ac%mv_from(tmpcoo)
+
+      call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
+      if (info == psb_success_) call psb_cdasb(desc_ac,info)
+
+      if (info /= psb_success_) goto 9999
+
+    case default 
       info = psb_err_internal_error_
       call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
       goto 9999
-    end if
-    
-    call op_prol%mv_to(tmpcoo)
-    nzl = tmpcoo%get_nzeros()
-    call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
-    call tmpcoo%set_ncols(i_nr)
-    call op_prol%mv_from(tmpcoo)
-
-    call op_restr%mv_to(tmpcoo)
-    nzl = tmpcoo%get_nzeros()
-    call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
-    call tmpcoo%set_nrows(i_nr)
-    call op_restr%mv_from(tmpcoo)
-
-
-    call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
-         & dupl=psb_dupl_add_,keeploc=.false.)
-    call tmp_ac%mv_to(tmpcoo)
-    call ac%mv_from(tmpcoo)
-    
-    call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
-    if (info == psb_success_) call psb_cdasb(desc_ac,info)
-
-    if (info /= psb_success_) goto 9999
-
-  case default 
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
-    goto 9999
-  end select
-
-
+    end select
+  else
+    call op_prol%allocate(izero,izero,info)
+    call op_restr%allocate(izero,izero,info)
+    call ac%allocate(izero,izero,info)
+  end if
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_s_dec_aggregator_mat_bld.f90

@@ -139,7 +139,7 @@ subroutine  amg_s_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   use amg_s_prec_type, amg_protect_name => amg_s_dec_aggregator_mat_bld
   use amg_s_inner_mod 
   implicit none
-  
+
   class(amg_s_dec_aggregator_type), target, intent(inout) :: ag
   type(amg_sml_parms), intent(inout)      :: parms 
   type(psb_sspmat_type), intent(in)    :: a
@@ -169,39 +169,46 @@ subroutine  amg_s_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
 
-  !
-  ! Build the coarse-level matrix from the fine-level one, starting from 
-  ! the mapping defined by amg_aggrmap_bld and applying the aggregation
-  ! algorithm specified by 
-  !
-  select case (parms%aggr_prol)
-  case (amg_no_smooth_) 
+  if (me >=0) then 
+    !
+    ! Build the coarse-level matrix from the fine-level one, starting from 
+    ! the mapping defined by amg_aggrmap_bld and applying the aggregation
+    ! algorithm specified by 
+    !
+    select case (parms%aggr_prol)
+    case (amg_no_smooth_) 
 
-    call amg_saggrmat_nosmth_bld(parms%aggr_prol,a,desc_a,ilaggr,&
-            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+      call amg_saggrmat_nosmth_bld(parms%aggr_prol,a,desc_a,ilaggr,&
+           nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
-  case(amg_smooth_prol_,amg_l1_smooth_prol_) 
+    case(amg_smooth_prol_,amg_l1_smooth_prol_) 
 
-    call amg_saggrmat_smth_bld(parms%aggr_prol,a,desc_a,&
-            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,&
-            op_restr,t_prol,info)
+      call amg_saggrmat_smth_bld(parms%aggr_prol,a,desc_a,&
+           ilaggr,nlaggr,parms,ac,desc_ac,op_prol,&
+           op_restr,t_prol,info)
 
 !!$  case(amg_biz_prol_) 
 !!$
 !!$    call amg_saggrmat_biz_bld(a,desc_a,ilaggr,nlaggr, &
 !!$         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
-  
-  case(amg_min_energy_) 
 
-    call amg_saggrmat_minnrg_bld(parms%aggr_prol,a,desc_a,ilaggr,&
-            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    case(amg_min_energy_) 
 
-  case default
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='Invalid aggr kind')
-    goto 9999
+      call amg_saggrmat_minnrg_bld(parms%aggr_prol,a,desc_a,ilaggr,&
+           nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+
+    case default
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,a_err='Invalid aggr kind')
+      goto 9999
+
+    end select
+  else
+    call op_prol%allocate(izero,izero,info)
+    call op_restr%allocate(izero,izero,info)
+    call ac%allocate(izero,izero,info)
+  end if
 
-  end select
   if (info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner aggrmat bld')
     goto 9999
@@ -214,5 +221,5 @@ subroutine  amg_s_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
 9999 call psb_error_handler(err_act)
   return
 
-  
+
 end subroutine amg_s_dec_aggregator_mat_bld

amgprec/impl/aggregator/amg_s_dec_aggregator_tprol.f90

@@ -122,19 +122,23 @@ subroutine  amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
   call amg_check_def(parms%aggr_ord,'Ordering',&
        &   amg_aggr_ord_nat_,is_legal_ml_aggr_ord)
   call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
+  if (me >=0) then 
+    !
+    ! The decoupled aggregator based on SOC measures ignores
+    ! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
+    !
+    if (do_timings) call psb_tic(idx_map_bld)
+    clean_zeros = ag%do_clean_zeros
+    call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
+    if (do_timings) call psb_toc(idx_map_bld)
+    if (do_timings) call psb_tic(idx_map_tprol)
 
-  !
-  ! The decoupled aggregator based on SOC measures ignores
-  ! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
-  !
-  if (do_timings) call psb_tic(idx_map_bld)
-  clean_zeros = ag%do_clean_zeros
-  call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
-  if (do_timings) call psb_toc(idx_map_bld)
-  if (do_timings) call psb_tic(idx_map_tprol)
-
-  if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
-  if (do_timings) call psb_toc(idx_map_tprol)
+    if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
+    if (do_timings) call psb_toc(idx_map_tprol)
+  else
+    allocate(nlaggr(0),ilaggr(0))
+    call t_prol%allocate(lzero,lzero,info)
+  end if
   if (info /= psb_success_) then
     info=psb_err_from_subroutine_
     call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

amgprec/impl/aggregator/amg_z_dec_aggregator_mat_asb.f90

@@ -114,63 +114,67 @@ subroutine  amg_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
   info  = psb_success_
   ctxt = desc_a%get_context()
   call psb_info(ctxt,me,np)
+  
+  if (me >=0) then 
+    select case(parms%coarse_mat)
 
-  select case(parms%coarse_mat)
+    case(amg_distr_mat_) 
 
-  case(amg_distr_mat_) 
+      call ac%cscnv(info,type='csr')
+      call op_prol%cscnv(info,type='csr')
+      call op_restr%cscnv(info,type='csr')
 
-    call ac%cscnv(info,type='csr')
-    call op_prol%cscnv(info,type='csr')
-    call op_restr%cscnv(info,type='csr')
+      if (debug_level >= psb_debug_outer_) &
+           & write(debug_unit,*) me,' ',trim(name),&
+           & 'Done ac '
 
-    if (debug_level >= psb_debug_outer_) &
-         & write(debug_unit,*) me,' ',trim(name),&
-         & 'Done ac '
+    case(amg_repl_mat_) 
+      !
+      ! We are assuming here that an z matrix
+      ! can hold all entries
+      !
+      if (desc_ac%get_global_rows() < huge(1_psb_ipk_) ) then 
+        ntaggr = desc_ac%get_global_rows()
+        i_nr   = ntaggr
+      else
+        info = psb_err_internal_error_
+        call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
+        goto 9999
+      end if
 
-  case(amg_repl_mat_) 
-    !
-    ! We are assuming here that an z matrix
-    ! can hold all entries
-    !
-    if (desc_ac%get_global_rows() < huge(1_psb_ipk_) ) then 
-      ntaggr = desc_ac%get_global_rows()
-      i_nr   = ntaggr
-    else
+      call op_prol%mv_to(tmpcoo)
+      nzl = tmpcoo%get_nzeros()
+      call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
+      call tmpcoo%set_ncols(i_nr)
+      call op_prol%mv_from(tmpcoo)
+
+      call op_restr%mv_to(tmpcoo)
+      nzl = tmpcoo%get_nzeros()
+      call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
+      call tmpcoo%set_nrows(i_nr)
+      call op_restr%mv_from(tmpcoo)
+
+
+      call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
+           & dupl=psb_dupl_add_,keeploc=.false.)
+      call tmp_ac%mv_to(tmpcoo)
+      call ac%mv_from(tmpcoo)
+
+      call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
+      if (info == psb_success_) call psb_cdasb(desc_ac,info)
+
+      if (info /= psb_success_) goto 9999
+
+    case default 
       info = psb_err_internal_error_
       call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
       goto 9999
-    end if
-    
-    call op_prol%mv_to(tmpcoo)
-    nzl = tmpcoo%get_nzeros()
-    call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
-    call tmpcoo%set_ncols(i_nr)
-    call op_prol%mv_from(tmpcoo)
-
-    call op_restr%mv_to(tmpcoo)
-    nzl = tmpcoo%get_nzeros()
-    call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
-    call tmpcoo%set_nrows(i_nr)
-    call op_restr%mv_from(tmpcoo)
-
-
-    call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
-         & dupl=psb_dupl_add_,keeploc=.false.)
-    call tmp_ac%mv_to(tmpcoo)
-    call ac%mv_from(tmpcoo)
-    
-    call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
-    if (info == psb_success_) call psb_cdasb(desc_ac,info)
-
-    if (info /= psb_success_) goto 9999
-
-  case default 
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
-    goto 9999
-  end select
-
-
+    end select
+  else
+    call op_prol%allocate(izero,izero,info)
+    call op_restr%allocate(izero,izero,info)
+    call ac%allocate(izero,izero,info)
+  end if
   call psb_erractionrestore(err_act)
   return