Merge branch 'dev-openmp' into TestFerdous

.gitignore

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

Makefile

@@ -3,9 +3,9 @@ include Make.inc
 
 all:  objs lib
 
-objs: libdir amgp cbnd
+objs: amgp cbnd
 
-lib:  objs
+lib: libdir objs
 	cd amgprec && $(MAKE) lib
 	cd cbind && $(MAKE)  lib
 

amgprec/Makefile

@@ -9,21 +9,21 @@ FINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(INCDIR) $(PSBLAS_INCLUDES)
 
 DMODOBJS=amg_d_prec_type.o \
 	amg_d_inner_mod.o amg_d_ilu_solver.o amg_d_diag_solver.o amg_d_jac_smoother.o amg_d_as_smoother.o \
-        amg_d_poly_smoother.o amg_d_poly_coeff_mod.o\
 	amg_d_umf_solver.o amg_d_slu_solver.o amg_d_sludist_solver.o amg_d_id_solver.o\
 	amg_d_base_solver_mod.o amg_d_base_smoother_mod.o amg_d_onelev_mod.o \
-	amg_d_gs_solver.o amg_d_mumps_solver.o amg_d_jac_solver.o \
+	amg_d_gs_solver.o amg_d_mumps_solver.o \
 	amg_d_base_aggregator_mod.o \
 	amg_d_dec_aggregator_mod.o amg_d_symdec_aggregator_mod.o \
 	amg_d_ainv_solver.o amg_d_base_ainv_mod.o \
 	amg_d_invk_solver.o amg_d_invt_solver.o amg_d_krm_solver.o \
-	amg_d_matchboxp_mod.o amg_d_parmatch_aggregator_mod.o
+	amg_d_matchboxp_mod.o amg_d_parmatch_aggregator_mod.o \
+        amg_d_newmatch_aggregator_mod.o amg_d_decmatch_mod.o
 
 SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \
 	amg_s_inner_mod.o amg_s_ilu_solver.o amg_s_diag_solver.o amg_s_jac_smoother.o amg_s_as_smoother.o \
-	amg_s_poly_smoother.o amg_s_slu_solver.o amg_s_id_solver.o\
+	amg_s_slu_solver.o amg_s_id_solver.o\
 	amg_s_base_solver_mod.o amg_s_base_smoother_mod.o amg_s_onelev_mod.o  \
-	amg_s_gs_solver.o amg_s_mumps_solver.o  amg_s_jac_solver.o \
+	amg_s_gs_solver.o amg_s_mumps_solver.o \
 	amg_s_base_aggregator_mod.o  \
 	amg_s_dec_aggregator_mod.o amg_s_symdec_aggregator_mod.o \
 	amg_s_ainv_solver.o amg_s_base_ainv_mod.o \
@@ -34,7 +34,7 @@ ZMODOBJS=amg_z_prec_type.o amg_z_ilu_fact_mod.o \
 	amg_z_inner_mod.o amg_z_ilu_solver.o amg_z_diag_solver.o amg_z_jac_smoother.o amg_z_as_smoother.o \
 	amg_z_umf_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o amg_z_id_solver.o\
 	amg_z_base_solver_mod.o amg_z_base_smoother_mod.o amg_z_onelev_mod.o \
-	amg_z_gs_solver.o amg_z_mumps_solver.o  amg_z_jac_solver.o \
+	amg_z_gs_solver.o amg_z_mumps_solver.o \
 	amg_z_base_aggregator_mod.o  \
 	amg_z_dec_aggregator_mod.o amg_z_symdec_aggregator_mod.o \
 	amg_z_ainv_solver.o amg_z_base_ainv_mod.o \
@@ -44,7 +44,7 @@ CMODOBJS=amg_c_prec_type.o amg_c_ilu_fact_mod.o \
 	amg_c_inner_mod.o amg_c_ilu_solver.o amg_c_diag_solver.o amg_c_jac_smoother.o amg_c_as_smoother.o \
 	amg_c_slu_solver.o amg_c_id_solver.o\
 	amg_c_base_solver_mod.o amg_c_base_smoother_mod.o amg_c_onelev_mod.o  \
-	amg_c_gs_solver.o amg_c_mumps_solver.o  amg_c_jac_solver.o \
+	amg_c_gs_solver.o amg_c_mumps_solver.o \
 	amg_c_base_aggregator_mod.o  \
 	amg_c_dec_aggregator_mod.o amg_c_symdec_aggregator_mod.o \
 	amg_c_ainv_solver.o amg_c_base_ainv_mod.o \
@@ -117,7 +117,7 @@ amg_c_prec_type.o: amg_c_onelev_mod.o
 amg_z_prec_type.o: amg_z_onelev_mod.o
 
 amg_s_onelev_mod.o: amg_s_base_smoother_mod.o amg_s_dec_aggregator_mod.o amg_s_parmatch_aggregator_mod.o 
-amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o amg_d_parmatch_aggregator_mod.o 
+amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o amg_d_parmatch_aggregator_mod.o amg_d_newmatch_aggregator_mod.o
 amg_c_onelev_mod.o: amg_c_base_smoother_mod.o amg_c_dec_aggregator_mod.o
 amg_z_onelev_mod.o: amg_z_base_smoother_mod.o amg_z_dec_aggregator_mod.o
 
@@ -130,6 +130,8 @@ amg_d_base_aggregator_mod.o: amg_base_prec_type.o
 amg_d_parmatch_aggregator_mod.o amg_d_dec_aggregator_mod.o: amg_d_base_aggregator_mod.o
 amg_d_hybrid_aggregator_mod.o amg_d_symdec_aggregator_mod.o: amg_d_dec_aggregator_mod.o
 amg_d_parmatch_aggregator_mod.o: amg_d_matchboxp_mod.o 
+amg_d_newmatch_aggregator_mod.o: amg_d_base_aggregator_mod.o
+amg_d_newmatch_aggregator_mod.o: amg_d_decmatch_mod.o
 
 amg_c_base_aggregator_mod.o: amg_base_prec_type.o
 amg_c_parmatch_aggregator_mod.o amg_c_dec_aggregator_mod.o: amg_c_base_aggregator_mod.o
@@ -156,7 +158,7 @@ amg_z_base_ainv_mod.o: amg_z_base_solver_mod.o amg_base_ainv_mod.o
 amg_s_base_solver_mod.o amg_d_base_solver_mod.o amg_c_base_solver_mod.o amg_z_base_solver_mod.o: amg_base_prec_type.o
 
 amg_d_mumps_solver.o amg_d_gs_solver.o amg_d_id_solver.o amg_d_sludist_solver.o amg_d_slu_solver.o \
-amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o amg_d_jac_solver.o: amg_d_base_solver_mod.o  amg_d_prec_type.o
+amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o: amg_d_base_solver_mod.o  amg_d_prec_type.o
 
 #amg_d_ilu_fact_mod.o: amg_base_prec_type.o  amg_d_base_solver_mod.o
 #amg_d_ilu_solver.o amg_d_iluk_fact.o: amg_d_ilu_fact_mod.o
@@ -165,11 +167,9 @@ amg_d_jac_smoother.o: amg_d_diag_solver.o
 amg_dprecinit.o amg_dprecset.o: amg_d_diag_solver.o amg_d_ilu_solver.o \
 		amg_d_umf_solver.o amg_d_as_smoother.o amg_d_jac_smoother.o \
 	        amg_d_id_solver.o amg_d_slu_solver.o amg_d_sludist_solver.o
-amg_d_poly_smoother.o: amg_d_base_smoother_mod.o amg_d_poly_coeff_mod.o
-amg_s_poly_smoother.o: amg_s_base_smoother_mod.o amg_d_poly_coeff_mod.o	
 
 amg_s_mumps_solver.o amg_s_gs_solver.o amg_s_id_solver.o amg_s_slu_solver.o \
-amg_s_diag_solver.o amg_s_ilu_solver.o amg_s_jac_solver.o: amg_s_base_solver_mod.o  amg_s_prec_type.o
+amg_s_diag_solver.o amg_s_ilu_solver.o: amg_s_base_solver_mod.o  amg_s_prec_type.o
 amg_s_ilu_fact_mod.o: amg_base_prec_type.o  amg_s_base_solver_mod.o
 amg_s_ilu_solver.o amg_s_iluk_fact.o: amg_s_ilu_fact_mod.o
 amg_s_as_smoother.o amg_s_jac_smoother.o: amg_s_base_smoother_mod.o
@@ -179,7 +179,7 @@ amg_sprecinit.o amg_sprecset.o: amg_s_diag_solver.o amg_s_ilu_solver.o \
 	        amg_s_id_solver.o amg_s_slu_solver.o
 
 amg_z_mumps_solver.o amg_z_gs_solver.o amg_z_id_solver.o amg_z_sludist_solver.o amg_z_slu_solver.o \
-amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o amg_z_jac_solver.o: amg_z_base_solver_mod.o  amg_z_prec_type.o
+amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o: amg_z_base_solver_mod.o  amg_z_prec_type.o
 amg_z_ilu_fact_mod.o: amg_base_prec_type.o  amg_z_base_solver_mod.o
 amg_z_ilu_solver.o amg_z_iluk_fact.o: amg_z_ilu_fact_mod.o
 amg_z_as_smoother.o amg_z_jac_smoother.o: amg_z_base_smoother_mod.o
@@ -189,7 +189,7 @@ amg_zprecinit.o amg_zprecset.o: amg_z_diag_solver.o amg_z_ilu_solver.o \
 	        amg_z_id_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o
 
 amg_c_mumps_solver.o amg_c_gs_solver.o amg_c_id_solver.o amg_c_sludist_solver.o amg_c_slu_solver.o \
-amg_c_diag_solver.o amg_c_ilu_solver.o amg_c_jac_solver.o: amg_c_base_solver_mod.o  amg_c_prec_type.o
+amg_c_diag_solver.o amg_c_ilu_solver.o: amg_c_base_solver_mod.o  amg_c_prec_type.o
 amg_c_ilu_fact_mod.o: amg_base_prec_type.o  amg_c_base_solver_mod.o
 amg_c_ilu_solver.o amg_c_iluk_fact.o: amg_c_ilu_fact_mod.o
 amg_c_as_smoother.o amg_c_jac_smoother.o: amg_c_base_smoother_mod.o

amgprec/amg_base_prec_type.F90

@@ -94,7 +94,6 @@ module amg_base_prec_type
     integer(psb_ipk_) :: aggr_omega_alg, aggr_eig, aggr_filter
     integer(psb_ipk_) :: coarse_mat, coarse_solve
   contains
-    procedure, pass(pm) :: get_coarse_mat  => ml_parms_get_coarse_mat
     procedure, pass(pm) :: get_coarse  => ml_parms_get_coarse
     procedure, pass(pm) :: clone       => ml_parms_clone
     procedure, pass(pm) :: descr       => ml_parms_descr
@@ -215,8 +214,7 @@ module amg_base_prec_type
   integer(psb_ipk_), parameter :: amg_fbgs_     = 6
   integer(psb_ipk_), parameter :: amg_l1_gs_    = 7
   integer(psb_ipk_), parameter :: amg_l1_fbgs_  = 8
-  integer(psb_ipk_), parameter :: amg_poly_     = 9
-  integer(psb_ipk_), parameter :: amg_max_prec_ = 9
+  integer(psb_ipk_), parameter :: amg_max_prec_ = 8
   !
   ! Constants for pre/post signaling. Now only used internally
   !
@@ -234,9 +232,9 @@ module amg_base_prec_type
   integer(psb_ipk_), parameter :: amg_diag_scale_    = amg_slv_delta_+1
   integer(psb_ipk_), parameter :: amg_l1_diag_scale_ = amg_slv_delta_+2
   integer(psb_ipk_), parameter :: amg_gs_            = amg_slv_delta_+3
-  integer(psb_ipk_), parameter :: amg_ilu_n_         = amg_slv_delta_+4
-  integer(psb_ipk_), parameter :: amg_milu_n_        = amg_slv_delta_+5
-  integer(psb_ipk_), parameter :: amg_ilu_t_         = amg_slv_delta_+6
+  ! !$  integer(psb_ipk_), parameter :: amg_ilu_n_         = amg_slv_delta_+4
+  ! !$  integer(psb_ipk_), parameter :: amg_milu_n_        = amg_slv_delta_+5
+  ! !$  integer(psb_ipk_), parameter :: amg_ilu_t_         = amg_slv_delta_+6
   integer(psb_ipk_), parameter :: amg_slu_           = amg_slv_delta_+7
   integer(psb_ipk_), parameter :: amg_umf_           = amg_slv_delta_+8
   integer(psb_ipk_), parameter :: amg_sludist_       = amg_slv_delta_+9
@@ -277,7 +275,8 @@ module amg_base_prec_type
   integer(psb_ipk_), parameter :: amg_sym_dec_aggr_  = 1
   integer(psb_ipk_), parameter :: amg_ext_aggr_      = 2
   integer(psb_ipk_), parameter :: amg_coupled_aggr_  = 3
-  integer(psb_ipk_), parameter :: amg_max_par_aggr_alg_  = amg_coupled_aggr_
+  integer(psb_ipk_), parameter :: amg_newmtc_aggr_   = 4
+  integer(psb_ipk_), parameter :: amg_max_par_aggr_alg_  = amg_newmtc_aggr_
   !
   ! Legal values for entry: amg_aggr_type_
   !
@@ -285,15 +284,15 @@ module amg_base_prec_type
   integer(psb_ipk_), parameter :: amg_soc1_        = 1
   integer(psb_ipk_), parameter :: amg_soc2_        = 2
   integer(psb_ipk_), parameter :: amg_matchboxp_   = 3
+  integer(psb_ipk_), parameter :: amg_newmatch_    = 4
   !
   ! Legal values for entry: amg_aggr_prol_
   !
-  integer(psb_ipk_), parameter :: amg_no_smooth_      = 0
-  integer(psb_ipk_), parameter :: amg_smooth_prol_    = 1
-  integer(psb_ipk_), parameter :: amg_l1_smooth_prol_ = 2
-  integer(psb_ipk_), parameter :: amg_min_energy_     = 3
+  integer(psb_ipk_), parameter :: amg_no_smooth_   = 0
+  integer(psb_ipk_), parameter :: amg_smooth_prol_ = 1
+  integer(psb_ipk_), parameter :: amg_min_energy_  = 2
   ! Disabling min_energy  for the time being.
-  integer(psb_ipk_), parameter :: amg_max_aggr_prol_= amg_l1_smooth_prol_
+  integer(psb_ipk_), parameter :: amg_max_aggr_prol_=amg_smooth_prol_
   !
   ! Legal values for entry: amg_aggr_filter_
   !
@@ -321,16 +320,6 @@ module amg_base_prec_type
   integer(psb_ipk_), parameter :: amg_distr_mat_      = 0
   integer(psb_ipk_), parameter :: amg_repl_mat_       = 1
   integer(psb_ipk_), parameter :: amg_max_coarse_mat_ = amg_repl_mat_
-  !
-  ! Legal values for entry: amg_poly_variant_
-  !
-  integer(psb_ipk_), parameter :: amg_cheb_4_     = 0
-  integer(psb_ipk_), parameter :: amg_cheb_4_opt_ = 1
-  integer(psb_ipk_), parameter :: amg_cheb_1_opt_ = 2
-  integer(psb_ipk_), parameter :: amg_poly_dbg_   = 8
-  
-  integer(psb_ipk_), parameter :: amg_poly_rho_est_power_ = 0
-
   !
   ! Legal values for entry: amg_prec_status_
   !
@@ -377,20 +366,21 @@ module amg_base_prec_type
   character(len=19), parameter, private :: &
        &  eigen_estimates(0:0)=(/'infinity norm     '/)
   character(len=15), parameter, private :: &
-       &  aggr_prols(0:4)=(/'unsmoothed    ','smoothed      ',&
-       &  'l1-smoothed   ','min energy    ','bizr. smoothed'/)
+       &  aggr_prols(0:3)=(/'unsmoothed    ','smoothed      ',&
+       &           'min energy    ','bizr. smoothed'/)
   character(len=15), parameter, private :: &
        &  aggr_filters(0:1)=(/'no filtering  ','filtering     '/)
   character(len=15), parameter, private :: &
        &  matrix_names(0:1)=(/'distributed   ','replicated    '/)
   character(len=18), parameter, private :: &
-       &  aggr_type_names(0:3)=(/'None              ',&
+       &  aggr_type_names(0:4)=(/'None              ',&
        &  'SOC measure 1     ', 'SOC Measure 2     ',&
-       &  'Parallel Matching '/)
+       &  'Parallel Matching ','Decoupled Matching'/)
   character(len=18), parameter, private :: &
-       &  par_aggr_alg_names(0:3)=(/&
+       &  par_aggr_alg_names(0:4)=(/&
        & 'decoupled aggr.   ', 'sym. dec. aggr.   ',&
-       & 'user defined aggr.', 'coupled aggr.     '/)
+       & 'user defined aggr.', 'coupled aggr.     ',&
+       & 'new matching aggr.'/)
   character(len=18), parameter, private :: &
        &  ord_names(0:1)=(/'Natural ordering  ','Desc. degree ord. '/)
   character(len=6), parameter, private :: &
@@ -402,12 +392,12 @@ module amg_base_prec_type
        &  ml_names(0:7)=(/'none          ','additive      ',&
        &  'multiplicative', 'VCycle        ','WCycle        ',&
        &  'KCycle        ','KCycleSym     ','new ML        '/)
-  character(len=16), parameter :: &
+  character(len=15), parameter :: &
        &  amg_fact_names(0:amg_max_sub_solve_)=(/&
        & 'none          ','Jacobi        ',&
        & 'L1-Jacobi     ','none          ','none          ',&
        & 'none          ','none          ','L1-GS         ',&
-       & 'L1-FBGS       ','Polynomial    ','none          ','Point Jacobi  ',&
+       & 'L1-FBGS       ','none          ','Point Jacobi  ',&
        & 'L1-Jacobi     ','Gauss-Seidel  ','ILU(n)        ',&
        & 'MILU(n)       ','ILU(t,n)      ',&
        & 'SuperLU       ','UMFPACK LU    ',&
@@ -469,12 +459,12 @@ contains
     character(len=*), parameter :: name='amg_stringval'
   ! Local variable
     integer :: index_tab
-    character(len=128) ::string2
+    character(len=15) ::string2
     index_tab=index(string,char(9))
     if (index_tab.NE.0)  then
-      string2=string(1:index_tab-1)
+       string2=string(1:index_tab-1)
     else
-      string2=string
+       string2=string
     endif
     select case(psb_toupper(trim(string2)))
     case('NONE')
@@ -494,11 +484,11 @@ contains
     case('BGS','BWGS')
       val = amg_bwgs_
     case('ILU')
-      val = amg_ilu_n_
+      val = psb_ilu_n_
     case('MILU')
-      val = amg_milu_n_
+      val = psb_milu_n_
     case('ILUT')
-      val = amg_ilu_t_
+      val = psb_ilu_t_
     case('MUMPS')
       val = amg_mumps_
     case('UMF')
@@ -529,6 +519,10 @@ contains
       val = amg_soc2_
     case('SOC1')
       val = amg_soc1_
+    case('NEWMATCH')
+      val = amg_newmatch_
+    case('NEWMTC')
+      val = amg_newmtc_aggr_
     case('MATCHBOXP','PARMATCH')
       val = amg_matchboxp_
     case('COUPLED','COUP')
@@ -549,8 +543,6 @@ contains
       val = amg_no_smooth_
     case('SMOOTHED')
       val = amg_smooth_prol_
-    case('L1-SMOOTHED','L1SMOOTHED')
-      val = amg_l1_smooth_prol_
     case('MINENERGY')
       val = amg_min_energy_
     case('NOPREC')
@@ -571,18 +563,6 @@ contains
       val = amg_krm_
     case('AS')
       val = amg_as_
-    case('POLY')
-      val = amg_poly_
-    case('CHEB_4')
-      val = amg_cheb_4_
-    case('CHEB_4_OPT')
-      val = amg_cheb_4_opt_
-    case('CHEB_1_OPT')
-      val = amg_cheb_1_opt_
-    case('POLY_DBG')
-      val = amg_poly_dbg_
-    case('POLY_RHO_EST_POWER')
-      val =  amg_poly_rho_est_power_
     case('A_NORMI')
       val = amg_max_norm_
     case('USER_CHOICE')
@@ -604,33 +584,6 @@ contains
     end select
   end function amg_stringval
 
-  function amg_get_coarse_mat_name(val) result(res)
-    character(len=15) :: res
-    integer :: val
-    select case(val)
-    case (0,1)
-      res = matrix_names(val)
-    case default
-      res = 'Unknown '
-    end select
-  end function amg_get_coarse_mat_name
-
-  subroutine amg_warn_coarse_mat(val,expected)
-    integer(psb_ipk_) :: val, expected
-    if (val /= expected) then
-      write(0,*) 'Warning: resetting COARSE_MAT on an existing hierarchy from ',&
-           & amg_get_coarse_mat_name(val), ' to ',amg_get_coarse_mat_name(expected)
-    end if
-  end subroutine amg_warn_coarse_mat
-
-  
-  function  ml_parms_get_coarse_mat(pm) result(res)
-    implicit none
-    class(amg_ml_parms), intent(in)    :: pm
-    integer(psb_ipk_) :: res
-    res   = pm%coarse_mat
-  end function ml_parms_get_coarse_mat
-
   subroutine  ml_parms_get_coarse(pm,pmin)
     implicit none
     class(amg_ml_parms), intent(inout) :: pm
@@ -693,10 +646,10 @@ contains
            &   ml_names(pm%ml_cycle)
       select case (pm%ml_cycle)
       case (amg_add_ml_)
-        write(iout,*) '  Number of smoother sweeps/degree : ',&
+        write(iout,*) '  Number of smoother sweeps : ',&
              & pm%sweeps_pre
       case (amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_, amg_kcycle_ml_, amg_kcyclesym_ml_)
-        write(iout,*) '  Number of smoother sweeps/degree : pre: ',&
+        write(iout,*) '  Number of smoother sweeps : pre: ',&
              &  pm%sweeps_pre ,'  post: ', pm%sweeps_post
       end select
 
@@ -1062,8 +1015,8 @@ contains
     integer(psb_ipk_), intent(in) :: ip
     logical             :: is_legal_ilu_fact
 
-    is_legal_ilu_fact = ((ip==amg_ilu_n_).or.&
-         & (ip==amg_milu_n_).or.(ip==amg_ilu_t_))
+    is_legal_ilu_fact = ((ip==psb_ilu_n_).or.&
+         & (ip==psb_milu_n_).or.(ip==psb_ilu_t_))
     return
   end function is_legal_ilu_fact
   function is_legal_d_omega(ip)

amgprec/amg_c_ainv_solver.F90

@@ -58,7 +58,6 @@ module amg_c_ainv_solver
     procedure, pass(sv) :: check   => amg_c_ainv_solver_check
     procedure, pass(sv) :: build   => amg_c_ainv_solver_bld
     procedure, pass(sv) :: clone   => amg_c_ainv_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_c_ainv_solver_clone_settings
     procedure, pass(sv) :: cseti   => amg_c_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_c_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_c_ainv_solver_csetr
@@ -86,16 +85,6 @@ module amg_c_ainv_solver
     end subroutine amg_c_ainv_solver_clone
   end interface
 
-  interface
-    subroutine amg_c_ainv_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
-       & amg_c_base_solver_type, psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
-      Implicit None
-      class(amg_c_ainv_solver_type), intent(inout)              :: sv
-      class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_c_ainv_solver_clone_settings
-  end interface
 
   interface
     subroutine amg_c_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)

amgprec/amg_c_ilu_solver.f90

@@ -234,7 +234,7 @@ contains
     ! Arguments
     class(amg_c_ilu_solver_type), intent(inout) :: sv
 
-    sv%fact_type = amg_ilu_n_
+    sv%fact_type = psb_ilu_n_
     sv%fill_in   = 0
     sv%thresh    = szero
 
@@ -255,13 +255,13 @@ contains
     info = psb_success_
 
     call amg_check_def(sv%fact_type,&
-         & 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
+         & 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
 
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
+    case(psb_ilu_n_,psb_milu_n_)      
       call amg_check_def(sv%fill_in,&
            & 'Level',izero,is_int_non_negative)
-    case(amg_ilu_t_)                 
+    case(psb_ilu_t_)                 
       call amg_check_def(sv%thresh,&
            & 'Eps',szero,is_legal_s_fact_thrs)
     end select
@@ -439,9 +439,9 @@ contains
     write(iout_,*) trim(prefix_), '  Incomplete factorization solver: ',&
          &  amg_fact_names(sv%fact_type)
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
+    case(psb_ilu_n_,psb_milu_n_)      
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-    case(amg_ilu_t_)         
+    case(psb_ilu_t_)         
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
       write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
     end select
@@ -496,7 +496,7 @@ contains
     implicit none 
     integer(psb_ipk_)  :: val
     
-    val = amg_ilu_n_
+    val = psb_ilu_n_
   end function c_ilu_solver_get_id
 
   function c_ilu_solver_get_wrksize() result(val)

amgprec/amg_c_inner_mod.f90

@@ -109,12 +109,11 @@ module amg_c_inner_mod
   end interface amg_map_to_tprol
 
   abstract interface
-    subroutine amg_caggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_caggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
          & ac,desc_ac,op_prol,op_restr,t_prol,info)
       import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_, psb_lcspmat_type
       import ::  amg_c_onelev_type, amg_sml_parms
       implicit none 
-      integer(psb_ipk_), intent(in)               :: dol1smoothing
       type(psb_cspmat_type), intent(in)         :: a
       type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)            :: ilaggr(:), nlaggr(:)

amgprec/amg_c_invk_solver.f90

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

amgprec/amg_c_invt_solver.f90

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

amgprec/amg_c_jac_solver.f90

@@ -1,585 +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 written permission.
-!   
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
-!
-!
-! File: amg_c_jac_solver_mod.f90
-!
-! Module: amg_c_jac_solver_mod
-!
-!  This module defines: 
-!  - the amg_c_jac_solver_type data structure containing the ingredients
-!    for a local Jacobi  iteration. The iterations are local to a process
-!    (they operate on the block diagonal).
-!    
-!
-module amg_c_jac_solver
-
-  use amg_c_base_solver_mod
-
-  type, extends(amg_c_base_solver_type) :: amg_c_jac_solver_type
-    type(psb_cspmat_type)      :: a
-    type(psb_c_vect_type), allocatable :: dv
-    complex(psb_spk_), allocatable        :: d(:)
-    integer(psb_ipk_)          :: sweeps
-    real(psb_spk_)             :: eps
-  contains
-    procedure, pass(sv) :: dump    => amg_c_jac_solver_dmp
-    procedure, pass(sv) :: check   => c_jac_solver_check
-    procedure, pass(sv) :: clone   => amg_c_jac_solver_clone
-    procedure, pass(sv) :: clone_settings => amg_c_jac_solver_clone_settings
-    procedure, pass(sv) :: clear_data     => amg_c_jac_solver_clear_data
-    procedure, pass(sv) :: build   => amg_c_jac_solver_bld
-    procedure, pass(sv) :: cnv     => amg_c_jac_solver_cnv
-    procedure, pass(sv) :: apply_v => amg_c_jac_solver_apply_vect
-    procedure, pass(sv) :: apply_a => amg_c_jac_solver_apply
-    procedure, pass(sv) :: free    => c_jac_solver_free
-    procedure, pass(sv) :: cseti   => c_jac_solver_cseti
-    procedure, pass(sv) :: csetc   => c_jac_solver_csetc
-    procedure, pass(sv) :: csetr   => c_jac_solver_csetr
-    procedure, pass(sv) :: descr   => c_jac_solver_descr
-    procedure, pass(sv) :: default => c_jac_solver_default
-    procedure, pass(sv) :: sizeof  => c_jac_solver_sizeof
-    procedure, pass(sv) :: get_nzeros => c_jac_solver_get_nzeros
-    procedure, nopass   :: get_wrksz  => c_jac_solver_get_wrksize
-    procedure, nopass   :: get_fmt    => c_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => c_jac_solver_get_id
-    procedure, nopass   :: is_iterative => c_jac_solver_is_iterative
-  end type amg_c_jac_solver_type
-
-  type, extends(amg_c_jac_solver_type) :: amg_c_l1_jac_solver_type
-  contains
-    procedure, pass(sv) :: build   => amg_c_l1_jac_solver_bld
-    procedure, pass(sv) :: descr   => c_l1_jac_solver_descr
-    procedure, nopass   :: get_fmt    => c_l1_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => c_l1_jac_solver_get_id
-  end type amg_c_l1_jac_solver_type
-
-
-  private :: c_jac_solver_bld, c_jac_solver_apply, &
-       &  c_jac_solver_free,   &
-       &  c_jac_solver_descr,  c_jac_solver_sizeof, &
-       &  c_jac_solver_default, c_jac_solver_dmp, &
-       &  c_jac_solver_apply_vect, c_jac_solver_get_nzeros, &
-       &  c_jac_solver_get_fmt, c_jac_solver_check,&
-       &  c_jac_solver_is_iterative, &
-       &  c_jac_solver_get_id, c_jac_solver_get_wrksize
-
-  interface 
-    subroutine amg_c_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,work,wv,info,init,initu)
-      import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
-           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)             :: desc_data
-      class(amg_c_jac_solver_type), intent(inout) :: sv
-      type(psb_c_vect_type),intent(inout)         :: x
-      type(psb_c_vect_type),intent(inout)         :: y
-      complex(psb_spk_),intent(in)                    :: alpha,beta
-      character(len=1),intent(in)                   :: trans
-      complex(psb_spk_),target, intent(inout)         :: work(:)
-      type(psb_c_vect_type),intent(inout)         :: wv(:)
-      integer(psb_ipk_), intent(out)                :: info
-      character, intent(in), optional                :: init
-      type(psb_c_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_c_jac_solver_apply_vect
-  end interface
-
-  interface 
-    subroutine amg_c_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
-      import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
-           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_c_jac_solver_type), intent(inout) :: sv
-      complex(psb_spk_),intent(inout)         :: x(:)
-      complex(psb_spk_),intent(inout)         :: y(:)
-      complex(psb_spk_),intent(in)            :: alpha,beta
-      character(len=1),intent(in)           :: trans
-      complex(psb_spk_),target, intent(inout) :: work(:)
-      integer(psb_ipk_), intent(out)        :: info
-      character, intent(in), optional       :: init
-      complex(psb_spk_),intent(inout), optional :: initu(:)
-    end subroutine amg_c_jac_solver_apply
-  end interface
-
-  interface 
-    subroutine amg_c_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
-           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_cspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_c_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_cspmat_type), intent(in), target, optional :: b
-      class(psb_c_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_c_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional   :: imold
-    end subroutine amg_c_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_c_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_c_l1_jac_solver_type, psb_c_vect_type, psb_spk_, &
-           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_cspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_c_l1_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_cspmat_type), intent(in), target, optional :: b
-      class(psb_c_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_c_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional   :: imold
-    end subroutine amg_c_l1_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_c_jac_solver_cnv(sv,info,amold,vmold,imold)
-      import :: amg_c_jac_solver_type, psb_spk_, &
-           & psb_c_base_sparse_mat, psb_c_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      class(amg_c_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      class(psb_c_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_c_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional   :: imold
-    end subroutine amg_c_jac_solver_cnv
-  end interface
-  
-  interface 
-    subroutine amg_c_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
-      import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
-           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, &
-           & psb_ipk_
-      implicit none 
-      class(amg_c_jac_solver_type), intent(in) :: sv
-      type(psb_desc_type), intent(in)             :: desc
-      integer(psb_ipk_), intent(in)              :: level
-      integer(psb_ipk_), intent(out)             :: info
-      character(len=*), intent(in), optional     :: prefix, head
-      logical, optional, intent(in)              :: solver, global_num
-    end subroutine amg_c_jac_solver_dmp
-  end interface
-  
-  interface
-    subroutine amg_c_jac_solver_clone(sv,svout,info)
-      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
-           & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
-           & amg_c_base_solver_type, amg_c_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_c_jac_solver_type), intent(inout)               :: sv
-      class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)              :: info
-    end subroutine amg_c_jac_solver_clone
-  end interface
-  
-!!$  interface
-!!$    subroutine amg_c_l1_jac_solver_clone(sv,svout,info)
-!!$      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
-!!$           & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
-!!$           & amg_c_base_solver_type, amg_c_l1_jac_solver_type, psb_ipk_
-!!$      Implicit None
-!!$      
-!!$      ! Arguments
-!!$      class(amg_c_l1_jac_solver_type), intent(inout)               :: sv
-!!$      class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
-!!$      integer(psb_ipk_), intent(out)              :: info
-!!$    end subroutine amg_c_l1_jac_solver_clone
-!!$  end interface
-
-  interface
-    subroutine amg_c_jac_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
-           & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
-           & amg_c_base_solver_type, amg_c_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_c_jac_solver_type), intent(inout) :: sv
-      class(amg_c_base_solver_type), intent(inout) :: svout
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_c_jac_solver_clone_settings
-  end interface
-
-  interface
-    subroutine amg_c_jac_solver_clear_data(sv,info)
-      import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
-           & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
-           & amg_c_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_c_jac_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(out)                 :: info
-    end subroutine amg_c_jac_solver_clear_data
-  end interface
-
-contains
-
-  subroutine c_jac_solver_default(sv)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(inout) :: sv
-
-    sv%sweeps = ione
-    sv%eps    = dzero
-    
-    return
-  end subroutine c_jac_solver_default
-
-  subroutine c_jac_solver_check(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20) :: name='c_jac_solver_check'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call amg_check_def(sv%sweeps,&
-         & 'Jacobi sweeps',ione,is_int_positive)
-
-    if (info /= psb_success_) goto 9999
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine c_jac_solver_check
-
-  subroutine c_jac_solver_cseti(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    integer(psb_ipk_), intent(in)                 :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='c_jac_solver_cseti'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-    select case(psb_toupper(what))
-    case('SOLVER_SWEEPS')
-      sv%sweeps = val      
-    case default
-      call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_jac_solver_cseti
-
-  subroutine c_jac_solver_csetc(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(inout) :: sv
-    character(len=*), intent(in)                  :: what 
-    character(len=*), intent(in)                  :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act, ival
-    character(len=20)  :: name='c_jac_solver_csetc'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-
-    call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
-  
-    if (info /= psb_success_) then
-      info = psb_err_from_subroutine_
-      call psb_errpush(info, name)
-      goto 9999
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_jac_solver_csetc
-  
-  subroutine c_jac_solver_csetr(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    real(psb_spk_), intent(in)                     :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='c_jac_solver_csetr'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    select case(psb_toupper(what))
-    case('SOLVER_EPS') 
-      sv%eps = val
-    case default
-      call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_jac_solver_csetr
-
-  subroutine c_jac_solver_free(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='c_jac_solver_free'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call sv%a%free()
-    if (allocated(sv%dv)) then
-      call sv%dv%free(info)
-      deallocate(sv%dv)
-    end if
-    if (allocated(sv%d)) deallocate(sv%d)
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_jac_solver_free
-
-  subroutine c_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_c_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_jac_solver_descr
-
-  function c_jac_solver_get_nzeros(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-    
-    val = 0 
-    val = val + sv%a%get_nzeros()
-    val = val + sv%dv%get_nrows()
-
-    return
-  end function c_jac_solver_get_nzeros
-
-  function c_jac_solver_sizeof(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_c_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-
-    val = psb_sizeof_ip 
-    val = val + sv%a%sizeof()
-    val = val + sv%dv%sizeof()
-
-    return
-  end function c_jac_solver_sizeof
-
-  function c_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "Jacobi solver"
-  end function c_jac_solver_get_fmt
-
-  function c_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_jac_
-  end function c_jac_solver_get_id
-
-  !
-  ! If this is true, then the solver needs a starting
-  ! guess. Currently only handled in JAC smoother. 
-  ! 
-  function c_jac_solver_is_iterative() result(val)
-    implicit none 
-    logical  :: val
-
-    val = .true.
-  end function c_jac_solver_is_iterative
-    
-  function c_jac_solver_get_wrksize() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = 2
-  end function c_jac_solver_get_wrksize
-
-  subroutine c_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_c_l1_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_c_l1_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine c_l1_jac_solver_descr
-
-  function c_l1_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "L1-Jacobi solver"
-  end function c_l1_jac_solver_get_fmt
-
-  function c_l1_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_l1_jac_
-  end function c_l1_jac_solver_get_id
-  
-end module amg_c_jac_solver

amgprec/amg_c_mumps_solver.F90

@@ -78,8 +78,7 @@ module amg_c_mumps_solver
     !
     ! Controls to be set before MUMPS instantiation:
     !
-    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: 'LOCAL_SOLVER
-    !                            1==amg_global_solver_: 'GLOBAL_SOLVER'
+    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: LOCAL   1==amg_global_solver_: GLOBAL
     ! IPAR(2) : MUMPS_PRINT_ERR  print verbosity (see MUMPS)
     ! IPAR(3) : MUMPS_SYM        0: non-symmetric   2: symmetric
     integer(psb_ipk_), dimension(3) :: ipar

amgprec/amg_c_onelev_mod.f90

@@ -187,10 +187,8 @@ module amg_c_onelev_mod
     procedure, pass(lv) :: clone   => c_base_onelev_clone
     procedure, pass(lv) :: cnv     => amg_c_base_onelev_cnv
     procedure, pass(lv) :: descr   => amg_c_base_onelev_descr
-    procedure, pass(lv) :: memory_use  => amg_c_base_onelev_memory_use
     procedure, pass(lv) :: default => c_base_onelev_default
     procedure, pass(lv) :: free    => amg_c_base_onelev_free
-    procedure, pass(lv) :: free_smoothers => amg_c_base_onelev_free_smoothers
     procedure, pass(lv) :: nullify => c_base_onelev_nullify
     procedure, pass(lv) :: check => amg_c_base_onelev_check
     procedure, pass(lv) :: dump  => amg_c_base_onelev_dump
@@ -274,23 +272,6 @@ module amg_c_onelev_mod
     end subroutine amg_c_base_onelev_descr
   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
-      Implicit None
-      ! Arguments
-      class(amg_c_onelev_type), intent(in)    :: lv
-      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_c_base_onelev_memory_use
-  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_, &
@@ -304,7 +285,7 @@ module amg_c_onelev_mod
     end subroutine amg_c_base_onelev_cnv
   end interface
 
-  interface
+interface
     subroutine amg_c_base_onelev_free(lv,info)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
            & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
@@ -316,18 +297,6 @@ module amg_c_onelev_mod
     end subroutine amg_c_base_onelev_free
   end interface
 
-  interface
-    subroutine amg_c_base_onelev_free_smoothers(lv,info)
-      import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
-           & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
-      implicit none
-
-      class(amg_c_onelev_type), intent(inout) :: lv
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_c_base_onelev_free_smoothers
-  end interface
-
   interface
     subroutine amg_c_base_onelev_check(lv,info)
       import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &

amgprec/amg_c_prec_type.f90

@@ -135,11 +135,8 @@ module amg_c_prec_type
     procedure, pass(prec)               :: build        => amg_cprecbld
     procedure, pass(prec)               :: hierarchy_build   => amg_c_hierarchy_bld
     procedure, pass(prec)               :: hierarchy_rebuild => amg_c_hierarchy_rebld
-    procedure, pass(prec)               :: hierarchy_free    => amg_c_hierarchy_free    
     procedure, pass(prec)               :: smoothers_build   => amg_c_smoothers_bld
-    procedure, pass(prec)               :: smoothers_free    => amg_c_smoothers_free
     procedure, pass(prec)               :: descr        =>  amg_cfile_prec_descr
-    procedure, pass(prec)               :: memory_use   =>  amg_cfile_prec_memory_use
   end type amg_cprec_type
 
   private :: amg_c_dump, amg_c_get_compl,  amg_c_cmp_compl,&
@@ -171,22 +168,6 @@ module amg_c_prec_type
     end subroutine amg_cfile_prec_descr
   end interface
 
-  
-  interface amg_memory_use
-    subroutine amg_cfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
-      import :: amg_cprec_type, psb_ipk_
-      implicit none
-      ! Arguments
-      class(amg_cprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: root
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_cfile_prec_memory_use
-  end interface
-
   interface amg_sizeof
     module procedure amg_cprec_sizeof
   end interface
@@ -364,14 +345,6 @@ module amg_c_prec_type
     end subroutine amg_c_smoothers_bld
   end interface amg_smoothers_bld
 
-  interface amg_smoothers_free
-    module procedure  amg_c_smoothers_free
-  end interface amg_smoothers_free
-
-  interface amg_hierarchy_free
-    module procedure amg_c_hierarchy_free
-  end interface amg_hierarchy_free
-
 contains
   !
   ! Function returning a pointer to the smoother
@@ -645,68 +618,6 @@ contains
 
   end subroutine amg_c_prec_free
 
-  subroutine amg_c_smoothers_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_cprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_c_smoothers_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
-        call prec%precv(i)%free_smoothers(info)
-      end do
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_c_smoothers_free
-
-  subroutine amg_c_hierarchy_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_cprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_c_hierarchy_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    me=-1
-    write(0,*) 'Missing implementation '
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_c_hierarchy_free
 
 
   !

amgprec/amg_d_ainv_solver.F90

@@ -58,7 +58,6 @@ module amg_d_ainv_solver
     procedure, pass(sv) :: check   => amg_d_ainv_solver_check
     procedure, pass(sv) :: build   => amg_d_ainv_solver_bld
     procedure, pass(sv) :: clone   => amg_d_ainv_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_d_ainv_solver_clone_settings
     procedure, pass(sv) :: cseti   => amg_d_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_d_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_d_ainv_solver_csetr
@@ -86,16 +85,6 @@ module amg_d_ainv_solver
     end subroutine amg_d_ainv_solver_clone
   end interface
 
-  interface
-    subroutine amg_d_ainv_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
-       & amg_d_base_solver_type, psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
-      Implicit None
-      class(amg_d_ainv_solver_type), intent(inout)              :: sv
-      class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_d_ainv_solver_clone_settings
-  end interface
 
   interface
     subroutine amg_d_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)

amgprec/amg_d_decmatch_mod.f90

@@ -0,0 +1,529 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!
+!    (C) Copyright 2021
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+module amg_d_decmatch_mod
+
+  use iso_c_binding
+  use psb_base_cbind_mod
+
+  interface new_Match_If
+    function dnew_Match_If(ipar,matching,lambda,nr, irp, ja, val, diag, w, mate) &
+         & bind(c,name="dnew_Match_If") result(res)
+      use iso_c_binding
+      import :: psb_c_ipk_, psb_c_lpk_, psb_c_mpk_, psb_c_epk_
+      implicit none
+
+      integer(psb_c_ipk_) :: res
+      integer(psb_c_ipk_), value :: nr,ipar,matching
+      real(c_double), value :: lambda      
+      type(c_ptr), value :: irp, ja, mate
+      type(c_ptr), value :: val, diag, w 
+    end function dnew_Match_If
+  end interface new_Match_If
+
+  interface amg_build_decmatch
+    module procedure amg_dbuild_decmatch
+  end interface amg_build_decmatch
+
+  logical, parameter, private :: print_statistics=.false.
+contains
+
+  subroutine amg_ddecmatch_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
+       & symmetrize,reproducible,display_inp, display_out, print_out, &
+       & parallel, matching,lambda)
+    use psb_base_mod
+    use psb_util_mod
+    use iso_c_binding
+    implicit none
+    real(psb_dpk_), allocatable, intent(inout)  :: w(:)
+    type(psb_dspmat_type), intent(inout)        :: a
+    type(psb_desc_type)                         :: desc_a
+    integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:)
+    integer(psb_lpk_), allocatable, intent(out) :: nlaggr(:)
+    type(psb_ldspmat_type), intent(out)         :: prol
+    integer(psb_ipk_), intent(out)              :: info
+    logical, optional, intent(in)               :: display_inp, display_out, reproducible
+    logical, optional, intent(in)               :: symmetrize, print_out, parallel
+    integer(psb_ipk_), optional, intent(in)     :: matching
+    real(psb_dpk_), optional, intent(in)        :: lambda
+
+    !
+    !
+    type(psb_ctxt_type) :: ictxt
+    integer(psb_ipk_) :: iam, np, iown
+    integer(psb_ipk_) :: nr, nc, sweep, nzl, ncsave, nct, idx
+    integer(psb_lpk_) :: i, k, kg, idxg, ntaggr, naggrm1, naggrp1, &
+         & ip, nlpairs, nlsingl, nunmatched, lnr
+    real(psb_dpk_)    :: wk, widx, wmax, nrmagg
+    real(psb_dpk_), allocatable    :: wtemp(:)
+    integer(psb_ipk_), allocatable :: mate(:)
+    integer(psb_lpk_), allocatable ::  ilv(:)
+    integer(psb_ipk_), save     :: cnt=1
+    character(len=256)          :: aname
+    type(psb_ld_coo_sparse_mat) :: tmpcoo
+    logical  :: display_out_, print_out_, reproducible_, parallel_
+    integer(psb_ipk_) :: matching_
+    real(psb_dpk_)    :: lambda_    
+    logical, parameter  :: dump=.false., debug=.false., dump_mate=.false., &
+         & debug_ilaggr=.false., debug_sync=.false.
+    integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
+    logical, parameter :: do_timings=.true.
+
+    ictxt = desc_a%get_ctxt()
+    call psb_info(ictxt,iam,np)
+
+    if ((do_timings).and.(idx_phase1==-1))       &
+         & idx_phase1 = psb_get_timer_idx("MBP_BLDP: phase1       ")
+    if ((do_timings).and.(idx_bldmtc==-1))       &
+         & idx_bldmtc = psb_get_timer_idx("MBP_BLDP: buil_matching")
+    if ((do_timings).and.(idx_phase2==-1))       &
+         & idx_phase2 = psb_get_timer_idx("MBP_BLDP: phase2       ")
+    if ((do_timings).and.(idx_phase3==-1))       &
+         & idx_phase3 = psb_get_timer_idx("MBP_BLDP: phase3       ")
+
+    if (do_timings) call psb_tic(idx_phase1)
+
+    if (present(display_out)) then
+      display_out_ = display_out
+    else
+      display_out_ = .false.
+    end if
+    if (present(print_out)) then
+      print_out_ = print_out
+    else
+      print_out_ = .false.
+    end if
+    if (present(reproducible)) then
+      reproducible_ = reproducible
+    else
+      reproducible_ = .false.
+    end if
+
+    if (present(parallel)) then
+      parallel_ = parallel
+    else
+      parallel_ = .true.
+    end if
+
+    if (present(matching)) then
+      matching_ = matching
+    else
+      matching_ = 2
+    end if
+
+    if (present(lambda)) then
+      lambda_ = lambda
+    else
+      lambda_ = 2.0
+    end if
+
+    allocate(nlaggr(0:np-1),stat=info)
+    if (info /= 0) then
+      return
+    end if
+
+    nlaggr = 0
+    ilv    = [(i,i=1,desc_a%get_local_cols())]
+    call desc_a%l2gip(ilv,info,owned=.false.)
+
+    call psb_geall(ilaggr,desc_a,info)
+    ilaggr = -1
+    call psb_geasb(ilaggr,desc_a,info)
+    nr = a%get_nrows()
+    nc = a%get_ncols()
+    if (size(w) < nc) then
+      call psb_realloc(nc,w,info)
+    end if
+    call psb_halo(w,desc_a,info)
+
+    if (debug) write(0,*) iam,' buildprol into buildmatching:',&
+         & nr, nc
+    if (debug_sync) then
+      call psb_barrier(ictxt)
+      if (iam == 0) write(0,*)' buildprol into buildmatching:',&
+           & nr, nc
+    end if
+    if (do_timings) call psb_toc(idx_phase1)
+    if (do_timings) call psb_tic(idx_bldmtc)
+    call amg_dbuild_decmatch(parallel_,matching_,lambda_,w,a,desc_a,mate,info)
+    if (do_timings) call psb_toc(idx_bldmtc)
+    if (debug) write(0,*) iam,' buildprol from buildmatching:',&
+         & info
+    if (debug_sync) then
+      call psb_barrier(ictxt)
+      if (iam == 0) write(0,*)' out from buildmatching:', info
+    end if
+
+    if (info == 0) then
+      if (do_timings) call psb_tic(idx_phase2)
+      if (debug_sync) then
+        call psb_barrier(ictxt)
+        if (iam == 0) write(0,*)' Into building the tentative prol:'
+      end if
+
+      call psb_geall(wtemp,desc_a,info)
+      wtemp      = dzero
+      call psb_geasb(wtemp,desc_a,info)
+
+      nlaggr(iam) = 0
+      nlpairs    = 0
+      nlsingl    = 0
+      nunmatched = 0
+      !
+      ! First sweep
+      ! On return from build_matching, mate has been converted to local numbering,
+      ! so assigning to idx is OK.
+      !
+      do k=1, nr
+        idx = mate(k)
+        !
+        ! Figure out an allocation of aggregates to processes
+        !
+        if (idx < 0) then
+          !
+          !  Unmatched vertex, potential  singleton.
+          !
+          nunmatched = nunmatched + 1
+          if (abs(w(k))<epsilon(nrmagg)) then
+            ! Keep it unaggregated
+            wtemp(k) = dzero
+          else
+            ! Create a singleton aggregate
+            nlaggr(iam) = nlaggr(iam) + 1
+            ilaggr(k)   = nlaggr(iam)
+            wtemp(k)    = w(k)/abs(w(k))
+            nlsingl     = nlsingl + 1
+          end if
+!!$          write(0,*) k,mate(k),ilaggr(k),' negative match ',abs(w(k)), epsilon(nrmagg)
+        else  if (idx > nc) then
+          write(0,*) 'Impossible: mate(k) > nc'
+          cycle
+        else
+
+          if (ilaggr(k) == -1) then
+
+            wk   = w(k)
+            widx = w(idx)
+            wmax = max(abs(wk),abs(widx))
+            nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
+            if (nrmagg > epsilon(nrmagg)) then
+              if (idx <= nr) then
+                if (ilaggr(idx) == -1) then
+                  ! Now, if both vertices are local, the aggregate is local
+                  ! (kinda obvious).
+                  nlaggr(iam) = nlaggr(iam) + 1
+                  ilaggr(k)   = nlaggr(iam)
+                  ilaggr(idx) = nlaggr(iam)
+                  wtemp(k)    = w(k)/nrmagg
+                  wtemp(idx)  = w(idx)/nrmagg
+                end if
+                nlpairs = nlpairs+1
+              else
+                write(0,*) 'Really?  mate(k) > nr? ',mate(k),nr
+              end if
+            else
+              if (abs(w(k))<epsilon(nrmagg)) then
+                ! Keep it unaggregated
+                wtemp(k) = dzero
+              else
+                ! Create a singleton aggregate
+                nlaggr(iam) = nlaggr(iam) + 1
+                ilaggr(k)   = nlaggr(iam)
+                wtemp(k)    = w(k)/abs(w(k))
+                nlsingl     = nlsingl + 1
+              end if
+            end if
+          end if
+        end if
+      end do
+      if (do_timings) call psb_toc(idx_phase2)
+      if (do_timings) call psb_tic(idx_phase3)
+
+      ! Ok, now compute offsets, gather halo and fix non-local
+      ! aggregates  (those where ilaggr == -2)
+      call psb_sum(ictxt,nlaggr)
+      ntaggr  = sum(nlaggr(0:np-1))
+      naggrm1 = sum(nlaggr(0:iam-1))
+      naggrp1 = sum(nlaggr(0:iam))
+      !
+      ! Shift all indices already assigned (i.e. >0)
+      !
+      do k=1,nr
+        if (ilaggr(k) > 0) then
+          ilaggr(k) = ilaggr(k) + naggrm1
+!!$        else
+!!$          write(0,*) 'Leftover ILAGGR',k,ilaggr(k),mate(k),abs(w(k)),epsilon(nrmagg)
+        end if
+      end do
+      call psb_halo(ilaggr,desc_a,info)
+      call psb_halo(wtemp,desc_a,info)
+      ! Cleanup as yet unmarked entries
+      do k=1,nr
+        if (ilaggr(k) == -2) then
+          idx = mate(k)
+          if (idx > nr) then
+            i   = ilaggr(idx)
+            if (i > 0) then
+              ilaggr(k) = i
+            else
+              write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
+            end if
+          else
+            write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
+          end if
+        end if
+        if (ilaggr(k) <0) then
+          write(0,*) 'Decmatch: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
+        end if
+      end do
+      if (debug_sync) then
+        call psb_barrier(ictxt)
+        if (iam == 0) write(0,*)' Done building the tentative prol:'
+      end if
+
+
+      if (dump_mate) then
+        block
+          integer(psb_lpk_), allocatable :: glaggr(:)
+          write(aname,'(a,i3.3,a,i3.3,a)') 'mateg-',cnt,'-p',iam,'.mtx'
+          open(20,file=aname)
+          write(20,'(a,I3,a)') '% sparse vector on process ',iam,' '
+          do k=1, nr
+            write(20,'(3(I8,1X))') ilv(k),ilv(mate(k))
+          end do
+          close(20)
+          write(aname,'(a,i3.3,a,i3.3,a)') 'nloc-',cnt,'-p',iam,'.mtx'
+          open(20,file=aname)
+          write(20,'(a,I3,a)') '% sparse vector on process ',iam,' '
+          write(20,'(a,I12,a)') 'nlpairs ',nlpairs
+          write(20,'(a,I12,a)') 'nlsingl ',nlsingl
+          write(20,'(a,I12,a)') 'nlaggr(iam) ',nlaggr(iam)
+          close(20)
+          write(aname,'(a,i3.3,a,i3.3,a,i3.3,a)') 'ilaggr-',cnt,'-i',iam,'-p',np,'.mtx'
+          open(20,file=aname)
+          write(20,'(a,I3,a)') '% sparse vector on process ',iam,' '
+          do k=1, nr
+            write(20,'(3(I8,1X))') ilv(k),ilaggr(k)
+          end do
+          close(20)
+
+          write(aname,'(a,i3.3,a,i3.3,a)') 'glaggr-',cnt,'-p',np,'.mtx'
+          call psb_gather(glaggr,ilaggr,desc_a,info,root=izero)
+          if (iam==0) call mm_array_write(glaggr,'Aggregates ',info,filename=aname)
+
+          cnt=cnt+1
+        end block
+      end if
+      block
+        integer(psb_lpk_) :: v(3)
+        v(1) = nunmatched
+        v(2) = nlsingl
+        v(3) = nlpairs
+        call psb_sum(ictxt,v)
+        nunmatched = v(1)
+        nlsingl    = v(2)
+        nlpairs    = v(3)
+
+      end block
+      if (print_statistics) then
+        if (iam == 0) then
+          write(0,*) 'Matching statistics: Unmatched nodes ',&
+               & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
+        end if
+      end if
+      
+      if (display_out_) then
+        block
+          integer(psb_ipk_) :: idx
+          !
+          !  And finally print out
+          !
+          do i=0,np-1
+            call psb_barrier(ictxt)
+            if (iam == i) then
+              write(0,*) 'Process ', iam,' hosts aggregates:  (',naggrm1+1,' : ',naggrp1-1,')'
+              do k=1, nr
+                idx  = mate(k)
+                kg    = ilv(k)
+                if (idx >0) then
+                  idxg  = ilv(idx)
+                else
+                  idxg = -1
+                end if
+                if (idx < 0) then
+                  write(0,*) kg,': singleton   (',kg,' ( Proc',iam,') ) into aggregate => ', ilaggr(k)
+                else if (idx <= nr) then
+                  write(0,*) kg,': paired with (',idxg,' ( Proc',iam,') ) into aggregate => ', ilaggr(k)
+                else
+                  call desc_a%indxmap%qry_halo_owner(idx,iown,info)
+                  write(0,*) kg,': paired with (',idxg,' ( Proc',iown,') ) into aggregate => ', ilaggr(k)
+                end if
+              end do
+              flush(0)
+            end if
+          end do
+        end block
+      end if
+
+      ! Dirty trick: allocate tmpcoo with local
+      ! number of aggregates, then change to ntaggr.
+      ! Just to make sure the allocation is not global
+      lnr = nr
+      call tmpcoo%allocate(lnr,nlaggr(iam),lnr)
+      k = 0
+      do i=1,nr
+        !
+        ! Note: at this point, a value ilaggr(i)<=0
+        ! tags an unaggregated row, and it has to be
+        ! left alone (i.e.: it should stay at fine level only)
+        !
+        if (ilaggr(i)>0) then
+          k = k + 1
+          tmpcoo%val(k) = wtemp(i)
+          tmpcoo%ia(k)  = i
+          tmpcoo%ja(k)  = ilaggr(i)
+        end if
+      end do
+      call tmpcoo%set_nzeros(k)
+      call tmpcoo%set_dupl(psb_dupl_add_)
+      call tmpcoo%set_sorted() ! This is now in row-major
+
+      if (display_out_) then
+        call psb_barrier(ictxt)
+        flush(0)
+
+        if (iam == 0) write(0,*) 'Prolongator: '
+        flush(0)
+        do i=0,np-1
+          call psb_barrier(ictxt)
+          if (iam == i) then
+            do k=1, nr
+              write(0,*) ilv(tmpcoo%ia(k)),tmpcoo%ja(k), tmpcoo%val(k)
+            end do
+            flush(0)
+          end if
+        end do
+      end if
+
+      call prol%mv_from(tmpcoo)
+      if (do_timings) call psb_toc(idx_phase3)
+
+      if (print_out_) then
+        write(aname,'(a,i3.3,a)') 'prol-g-',iam,'.mtx'
+        call prol%print(fname=aname,head='Test ',ivr=ilv)
+        write(aname,'(a,i3.3,a)') 'prol-',iam,'.mtx'
+        call prol%print(fname=aname,head='Test ')
+      end if
+
+    else
+      write(0,*) iam,' :  error from Matching: ',info
+    end if
+
+  end subroutine amg_ddecmatch_build_prol
+
+  subroutine amg_dbuild_decmatch(parallel,matching,lambda,w,a,desc_a,mate,info)
+    use psb_base_mod
+    use psb_util_mod
+    use iso_c_binding
+    implicit none
+    logical, intent(in)               :: parallel
+    integer(psb_ipk_), intent(in)     :: matching
+    real(psb_dpk_), intent(in)        :: lambda
+    real(psb_dpk_), target                      :: w(:)
+    type(psb_dspmat_type), intent(inout)        :: a
+    type(psb_desc_type)                         :: desc_a
+    integer(psb_ipk_), allocatable, intent(out), target :: mate(:)
+    integer(psb_ipk_), intent(out)              :: info
+
+    type(psb_d_csr_sparse_mat), target :: tcsr
+    real(psb_dpk_), allocatable, target :: diag(:)
+    real(psb_dpk_) :: ph0t,ph1t,ph2t
+    type(psb_ctxt_type) :: ictxt
+    integer(psb_ipk_) :: iam, np
+    integer(psb_ipk_)  :: nr, nc, nz, i, nunmatch, ipar 
+    integer(psb_ipk_), save :: cnt=2
+    logical, parameter :: debug=.false., dump_ahat=.false., debug_sync=.false.
+    logical, parameter :: old_style=.false., sort_minp=.true.
+    character(len=40) :: name='build_matching', fname
+    integer(psb_ipk_), save :: idx_cmboxp=-1, idx_bldahat=-1, idx_phase2=-1, idx_phase3=-1
+    logical, parameter :: do_timings=.true.
+
+    ictxt = desc_a%get_ctxt()
+    call psb_info(ictxt,iam,np)
+
+    nr = a%get_nrows()
+    call a%cp_to(tcsr)
+    call psb_realloc(nr,mate,info)
+    diag = a%get_diag(info)
+    if (parallel) then
+      ipar = 2
+    else
+      ipar = 1
+    end if
+    !
+    ! Now call matching!
+    !
+    if (debug) write(0,*) iam,' buildmatching into NewMatch:'
+    if (do_timings) call psb_tic(idx_cmboxp)
+    info = dnew_Match_If(ipar,matching,lambda,nr,c_loc(tcsr%irp),c_loc(tcsr%ja),&
+         & c_loc(tcsr%val),c_loc(diag),c_loc(w),c_loc(mate))
+    if (do_timings) call psb_toc(idx_cmboxp)
+    if (debug) write(0,*) iam,' buildmatching from NewMatch:', info
+    if (debug_sync) then
+      call psb_max(ictxt,info)
+      if (iam == 0) write(0,*)' done NewMatch', info
+    end if
+
+    if (do_timings) call psb_tic(idx_phase3)
+    nunmatch = count(mate(1:nr)<=0)
+        ! call psb_sum(ictxt,nunmatch)
+    !if (nunmatch /= 0) write(0,*) iam,' Unmatched nodes local imbalance ',nunmatch
+    !    if (count(mate(1:nr)<0) /= nunmatch) write(0,*) iam,' Matching results ?',&
+    !        & nunmatch, count(mate(1:nr)<0)
+    if (debug_sync) then
+      call psb_barrier(ictxt)
+      if (iam == 0) write(0,*)' done build_matching '
+    end if
+
+    if (do_timings) call psb_toc(idx_phase3)
+    return
+
+9999 continue
+    call psb_error(ictxt)
+
+  end subroutine amg_dbuild_decmatch
+
+end module amg_d_decmatch_mod

amgprec/amg_d_ilu_solver.f90

@@ -234,7 +234,7 @@ contains
     ! Arguments
     class(amg_d_ilu_solver_type), intent(inout) :: sv
 
-    sv%fact_type = amg_ilu_n_
+    sv%fact_type = psb_ilu_n_
     sv%fill_in   = 0
     sv%thresh    = dzero
 
@@ -255,13 +255,13 @@ contains
     info = psb_success_
 
     call amg_check_def(sv%fact_type,&
-         & 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
+         & 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
 
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
+    case(psb_ilu_n_,psb_milu_n_)      
       call amg_check_def(sv%fill_in,&
            & 'Level',izero,is_int_non_negative)
-    case(amg_ilu_t_)                 
+    case(psb_ilu_t_)                 
       call amg_check_def(sv%thresh,&
            & 'Eps',dzero,is_legal_d_fact_thrs)
     end select
@@ -439,9 +439,9 @@ contains
     write(iout_,*) trim(prefix_), '  Incomplete factorization solver: ',&
          &  amg_fact_names(sv%fact_type)
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
+    case(psb_ilu_n_,psb_milu_n_)      
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-    case(amg_ilu_t_)         
+    case(psb_ilu_t_)         
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
       write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
     end select
@@ -496,7 +496,7 @@ contains
     implicit none 
     integer(psb_ipk_)  :: val
     
-    val = amg_ilu_n_
+    val = psb_ilu_n_
   end function d_ilu_solver_get_id
 
   function d_ilu_solver_get_wrksize() result(val)

amgprec/amg_d_inner_mod.f90

@@ -109,12 +109,11 @@ module amg_d_inner_mod
   end interface amg_map_to_tprol
 
   abstract interface
-    subroutine amg_daggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_daggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
          & ac,desc_ac,op_prol,op_restr,t_prol,info)
       import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_, psb_lpk_, psb_ldspmat_type
       import ::  amg_d_onelev_type, amg_dml_parms
       implicit none 
-      integer(psb_ipk_), intent(in)               :: dol1smoothing
       type(psb_dspmat_type), intent(in)         :: a
       type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)            :: ilaggr(:), nlaggr(:)

amgprec/amg_d_invk_solver.f90

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

amgprec/amg_d_invt_solver.f90

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

amgprec/amg_d_jac_solver.f90

@@ -1,585 +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 written permission.
-!   
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
-!
-!
-! File: amg_d_jac_solver_mod.f90
-!
-! Module: amg_d_jac_solver_mod
-!
-!  This module defines: 
-!  - the amg_d_jac_solver_type data structure containing the ingredients
-!    for a local Jacobi  iteration. The iterations are local to a process
-!    (they operate on the block diagonal).
-!    
-!
-module amg_d_jac_solver
-
-  use amg_d_base_solver_mod
-
-  type, extends(amg_d_base_solver_type) :: amg_d_jac_solver_type
-    type(psb_dspmat_type)      :: a
-    type(psb_d_vect_type), allocatable :: dv
-    real(psb_dpk_), allocatable        :: d(:)
-    integer(psb_ipk_)          :: sweeps
-    real(psb_dpk_)             :: eps
-  contains
-    procedure, pass(sv) :: dump    => amg_d_jac_solver_dmp
-    procedure, pass(sv) :: check   => d_jac_solver_check
-    procedure, pass(sv) :: clone   => amg_d_jac_solver_clone
-    procedure, pass(sv) :: clone_settings => amg_d_jac_solver_clone_settings
-    procedure, pass(sv) :: clear_data     => amg_d_jac_solver_clear_data
-    procedure, pass(sv) :: build   => amg_d_jac_solver_bld
-    procedure, pass(sv) :: cnv     => amg_d_jac_solver_cnv
-    procedure, pass(sv) :: apply_v => amg_d_jac_solver_apply_vect
-    procedure, pass(sv) :: apply_a => amg_d_jac_solver_apply
-    procedure, pass(sv) :: free    => d_jac_solver_free
-    procedure, pass(sv) :: cseti   => d_jac_solver_cseti
-    procedure, pass(sv) :: csetc   => d_jac_solver_csetc
-    procedure, pass(sv) :: csetr   => d_jac_solver_csetr
-    procedure, pass(sv) :: descr   => d_jac_solver_descr
-    procedure, pass(sv) :: default => d_jac_solver_default
-    procedure, pass(sv) :: sizeof  => d_jac_solver_sizeof
-    procedure, pass(sv) :: get_nzeros => d_jac_solver_get_nzeros
-    procedure, nopass   :: get_wrksz  => d_jac_solver_get_wrksize
-    procedure, nopass   :: get_fmt    => d_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => d_jac_solver_get_id
-    procedure, nopass   :: is_iterative => d_jac_solver_is_iterative
-  end type amg_d_jac_solver_type
-
-  type, extends(amg_d_jac_solver_type) :: amg_d_l1_jac_solver_type
-  contains
-    procedure, pass(sv) :: build   => amg_d_l1_jac_solver_bld
-    procedure, pass(sv) :: descr   => d_l1_jac_solver_descr
-    procedure, nopass   :: get_fmt    => d_l1_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => d_l1_jac_solver_get_id
-  end type amg_d_l1_jac_solver_type
-
-
-  private :: d_jac_solver_bld, d_jac_solver_apply, &
-       &  d_jac_solver_free,   &
-       &  d_jac_solver_descr,  d_jac_solver_sizeof, &
-       &  d_jac_solver_default, d_jac_solver_dmp, &
-       &  d_jac_solver_apply_vect, d_jac_solver_get_nzeros, &
-       &  d_jac_solver_get_fmt, d_jac_solver_check,&
-       &  d_jac_solver_is_iterative, &
-       &  d_jac_solver_get_id, d_jac_solver_get_wrksize
-
-  interface 
-    subroutine amg_d_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,work,wv,info,init,initu)
-      import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)             :: desc_data
-      class(amg_d_jac_solver_type), intent(inout) :: sv
-      type(psb_d_vect_type),intent(inout)         :: x
-      type(psb_d_vect_type),intent(inout)         :: y
-      real(psb_dpk_),intent(in)                    :: alpha,beta
-      character(len=1),intent(in)                   :: trans
-      real(psb_dpk_),target, intent(inout)         :: work(:)
-      type(psb_d_vect_type),intent(inout)         :: wv(:)
-      integer(psb_ipk_), intent(out)                :: info
-      character, intent(in), optional                :: init
-      type(psb_d_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_d_jac_solver_apply_vect
-  end interface
-
-  interface 
-    subroutine amg_d_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
-      import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_d_jac_solver_type), intent(inout) :: sv
-      real(psb_dpk_),intent(inout)         :: x(:)
-      real(psb_dpk_),intent(inout)         :: y(:)
-      real(psb_dpk_),intent(in)            :: alpha,beta
-      character(len=1),intent(in)           :: trans
-      real(psb_dpk_),target, intent(inout) :: work(:)
-      integer(psb_ipk_), intent(out)        :: info
-      character, intent(in), optional       :: init
-      real(psb_dpk_),intent(inout), optional :: initu(:)
-    end subroutine amg_d_jac_solver_apply
-  end interface
-
-  interface 
-    subroutine amg_d_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_dspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_d_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_dspmat_type), intent(in), target, optional :: b
-      class(psb_d_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_d_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional   :: imold
-    end subroutine amg_d_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_d_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_d_l1_jac_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_dspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_d_l1_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_dspmat_type), intent(in), target, optional :: b
-      class(psb_d_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_d_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional   :: imold
-    end subroutine amg_d_l1_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_d_jac_solver_cnv(sv,info,amold,vmold,imold)
-      import :: amg_d_jac_solver_type, psb_dpk_, &
-           & psb_d_base_sparse_mat, psb_d_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      class(amg_d_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      class(psb_d_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_d_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional   :: imold
-    end subroutine amg_d_jac_solver_cnv
-  end interface
-  
-  interface 
-    subroutine amg_d_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
-      import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
-           & psb_ipk_
-      implicit none 
-      class(amg_d_jac_solver_type), intent(in) :: sv
-      type(psb_desc_type), intent(in)             :: desc
-      integer(psb_ipk_), intent(in)              :: level
-      integer(psb_ipk_), intent(out)             :: info
-      character(len=*), intent(in), optional     :: prefix, head
-      logical, optional, intent(in)              :: solver, global_num
-    end subroutine amg_d_jac_solver_dmp
-  end interface
-  
-  interface
-    subroutine amg_d_jac_solver_clone(sv,svout,info)
-      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
-           & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
-           & amg_d_base_solver_type, amg_d_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_d_jac_solver_type), intent(inout)               :: sv
-      class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)              :: info
-    end subroutine amg_d_jac_solver_clone
-  end interface
-  
-!!$  interface
-!!$    subroutine amg_d_l1_jac_solver_clone(sv,svout,info)
-!!$      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
-!!$           & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
-!!$           & amg_d_base_solver_type, amg_d_l1_jac_solver_type, psb_ipk_
-!!$      Implicit None
-!!$      
-!!$      ! Arguments
-!!$      class(amg_d_l1_jac_solver_type), intent(inout)               :: sv
-!!$      class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
-!!$      integer(psb_ipk_), intent(out)              :: info
-!!$    end subroutine amg_d_l1_jac_solver_clone
-!!$  end interface
-
-  interface
-    subroutine amg_d_jac_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
-           & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
-           & amg_d_base_solver_type, amg_d_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_d_jac_solver_type), intent(inout) :: sv
-      class(amg_d_base_solver_type), intent(inout) :: svout
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_d_jac_solver_clone_settings
-  end interface
-
-  interface
-    subroutine amg_d_jac_solver_clear_data(sv,info)
-      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
-           & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
-           & amg_d_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_d_jac_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(out)                 :: info
-    end subroutine amg_d_jac_solver_clear_data
-  end interface
-
-contains
-
-  subroutine d_jac_solver_default(sv)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(inout) :: sv
-
-    sv%sweeps = ione
-    sv%eps    = dzero
-    
-    return
-  end subroutine d_jac_solver_default
-
-  subroutine d_jac_solver_check(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20) :: name='d_jac_solver_check'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call amg_check_def(sv%sweeps,&
-         & 'Jacobi sweeps',ione,is_int_positive)
-
-    if (info /= psb_success_) goto 9999
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine d_jac_solver_check
-
-  subroutine d_jac_solver_cseti(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    integer(psb_ipk_), intent(in)                 :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='d_jac_solver_cseti'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-    select case(psb_toupper(what))
-    case('SOLVER_SWEEPS')
-      sv%sweeps = val      
-    case default
-      call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_jac_solver_cseti
-
-  subroutine d_jac_solver_csetc(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(inout) :: sv
-    character(len=*), intent(in)                  :: what 
-    character(len=*), intent(in)                  :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act, ival
-    character(len=20)  :: name='d_jac_solver_csetc'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-
-    call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
-  
-    if (info /= psb_success_) then
-      info = psb_err_from_subroutine_
-      call psb_errpush(info, name)
-      goto 9999
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_jac_solver_csetc
-  
-  subroutine d_jac_solver_csetr(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    real(psb_dpk_), intent(in)                     :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='d_jac_solver_csetr'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    select case(psb_toupper(what))
-    case('SOLVER_EPS') 
-      sv%eps = val
-    case default
-      call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_jac_solver_csetr
-
-  subroutine d_jac_solver_free(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='d_jac_solver_free'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call sv%a%free()
-    if (allocated(sv%dv)) then
-      call sv%dv%free(info)
-      deallocate(sv%dv)
-    end if
-    if (allocated(sv%d)) deallocate(sv%d)
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_jac_solver_free
-
-  subroutine d_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_d_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_jac_solver_descr
-
-  function d_jac_solver_get_nzeros(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-    
-    val = 0 
-    val = val + sv%a%get_nzeros()
-    val = val + sv%dv%get_nrows()
-
-    return
-  end function d_jac_solver_get_nzeros
-
-  function d_jac_solver_sizeof(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_d_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-
-    val = psb_sizeof_ip 
-    val = val + sv%a%sizeof()
-    val = val + sv%dv%sizeof()
-
-    return
-  end function d_jac_solver_sizeof
-
-  function d_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "Jacobi solver"
-  end function d_jac_solver_get_fmt
-
-  function d_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_jac_
-  end function d_jac_solver_get_id
-
-  !
-  ! If this is true, then the solver needs a starting
-  ! guess. Currently only handled in JAC smoother. 
-  ! 
-  function d_jac_solver_is_iterative() result(val)
-    implicit none 
-    logical  :: val
-
-    val = .true.
-  end function d_jac_solver_is_iterative
-    
-  function d_jac_solver_get_wrksize() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = 2
-  end function d_jac_solver_get_wrksize
-
-  subroutine d_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_l1_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_d_l1_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_l1_jac_solver_descr
-
-  function d_l1_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "L1-Jacobi solver"
-  end function d_l1_jac_solver_get_fmt
-
-  function d_l1_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_l1_jac_
-  end function d_l1_jac_solver_get_id
-  
-end module amg_d_jac_solver

amgprec/amg_d_mumps_solver.F90

@@ -78,8 +78,7 @@ module amg_d_mumps_solver
     !
     ! Controls to be set before MUMPS instantiation:
     !
-    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: 'LOCAL_SOLVER
-    !                            1==amg_global_solver_: 'GLOBAL_SOLVER'
+    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: LOCAL   1==amg_global_solver_: GLOBAL
     ! IPAR(2) : MUMPS_PRINT_ERR  print verbosity (see MUMPS)
     ! IPAR(3) : MUMPS_SYM        0: non-symmetric   2: symmetric
     integer(psb_ipk_), dimension(3) :: ipar

amgprec/amg_d_newmatch_aggregator_mod.F90

@@ -0,0 +1,585 @@
+!
+!
+!  The aggregator object hosts the aggregation method for building
+!  the multilevel hierarchy. This variant is based on the hybrid method
+!  presented in 
+!
+!
+!   sm           -  class(amg_T_base_smoother_type), allocatable
+!                   The current level preconditioner (aka smoother).
+!   parms        -  type(amg_RTml_parms)
+!                   The parameters defining the multilevel strategy.
+!   ac           -  The local part of the current-level matrix, built by
+!                   coarsening the previous-level matrix.
+!   desc_ac      -  type(psb_desc_type).
+!                   The communication descriptor associated to the matrix
+!                   stored in ac.
+!   base_a       -  type(psb_Tspmat_type), pointer.
+!                   Pointer (really a pointer!) to the local part of the current 
+!                   matrix (so we have a unified treatment of residuals).
+!                   We need this to avoid passing explicitly the current matrix
+!                   to the routine which applies the preconditioner.
+!   base_desc    -  type(psb_desc_type), pointer.
+!                   Pointer to the communication descriptor associated to the
+!                   matrix pointed by base_a.
+!   map          -  Stores the maps (restriction and prolongation) between the
+!                   vector spaces associated to the index spaces of the previous
+!                   and current levels.
+!
+!   Methods:  
+!     Most methods follow the encapsulation hierarchy: they take whatever action
+!     is appropriate for the current object, then call the corresponding method for
+!     the contained object.
+!     As an example: the descr() method prints out a description of the
+!     level. It starts by invoking the descr() method of the parms object,
+!     then calls the descr() method of the smoother object. 
+!
+!    descr      -   Prints a description of the object.
+!    default    -   Set default values
+!    dump       -   Dump to file object contents
+!    set        -   Sets various parameters; when a request is unknown
+!                   it is passed to the smoother object for further processing.
+!    check      -   Sanity checks.
+!    sizeof     -   Total memory occupation in bytes
+!    get_nzeros -   Number of nonzeros 
+!
+!
+
+module amg_d_newmatch_aggregator_mod
+  use amg_d_base_aggregator_mod
+  use iso_c_binding
+  
+  type, bind(c)::  nwm_Vector
+    type(c_ptr) :: data
+    integer(c_int) :: size
+    integer(c_int) :: owns_data
+  end type nwm_Vector
+  
+  type, bind(c)::  nwm_CSRMatrix
+    type(c_ptr) :: i
+    type(c_ptr) :: j
+    integer(c_int) :: num_rows
+    integer(c_int) :: num_cols
+    integer(c_int) :: num_nonzeros
+    integer(c_int) :: owns_data
+    type(c_ptr) :: data
+  end type nwm_CSRMatrix
+  
+  type, extends(amg_d_base_aggregator_type) :: amg_d_newmatch_aggregator_type
+    integer(psb_ipk_) :: matching_alg
+    integer(psb_ipk_) :: n_sweeps
+    !
+    !  Note: the BootCMatch kernel we invoke  overwrites
+    !  the W argument with its update. Hence, copy it in w_nxt
+    !  before passing it to the matching
+    !
+    integer(psb_ipk_) :: orig_aggr_size
+    integer(psb_ipk_) :: jacobi_sweeps
+    real(psb_dpk_), allocatable :: w(:), w_nxt(:)
+    type(psb_dspmat_type), allocatable  :: prol, restr
+    type(psb_dspmat_type), allocatable  :: ac, base_a, rwa
+    type(psb_desc_type), allocatable    :: desc_ac, desc_ax, base_desc, rwdesc
+    type(nwm_Vector)  :: w_c_nxt
+    integer(psb_ipk_) :: max_csize
+    integer(psb_ipk_) :: max_nlevels
+    real(psb_dpk_)    :: lambda
+    logical           :: reproducible_matching = .false.
+    logical           :: need_symmetrize       = .false.
+    logical           :: unsmoothed_hierarchy  = .true.
+    logical           :: parallel_matching     = .true. 
+  contains
+    procedure, pass(ag) :: bld_tprol    => amg_d_newmatch_aggregator_build_tprol
+    procedure, pass(ag) :: csetc        => amg_d_newmatch_aggr_csetc
+    procedure, pass(ag) :: csetr        => amg_d_newmatch_aggr_csetr
+    procedure, pass(ag) :: cseti        => d_newmatch_aggr_cseti
+    procedure, pass(ag) :: default      => d_newmatch_aggr_set_default
+    procedure, pass(ag) :: mat_asb      => amg_d_newmatch_aggregator_mat_asb
+    procedure, pass(ag) :: mat_bld      => amg_d_newmatch_aggregator_mat_bld
+    procedure, pass(ag) :: inner_mat_asb => amg_d_newmatch_aggregator_inner_mat_asb
+    procedure, pass(ag) :: update_next  => d_newmatch_aggregator_update_next
+    procedure, pass(ag) :: bld_wnxt     => d_newmatch_bld_wnxt
+    procedure, pass(ag) :: bld_default_w    => d_bld_default_w
+    procedure, pass(ag) :: set_c_default_w  => d_set_default_nwm_w
+    procedure, pass(ag) :: descr        => d_newmatch_aggregator_descr
+    procedure, pass(ag) :: clone        => d_newmatch_aggregator_clone
+    procedure, pass(ag) :: free         => d_newmatch_aggregator_free
+    procedure, nopass   :: fmt          => d_newmatch_aggregator_fmt
+  end type amg_d_newmatch_aggregator_type
+
+
+  interface
+    subroutine  amg_d_newmatch_aggregator_build_tprol(ag,parms,ag_data,&
+         & a,desc_a,ilaggr,nlaggr,t_prol,info)
+      import :: amg_d_newmatch_aggregator_type, psb_desc_type, &
+           & psb_dspmat_type, psb_ldspmat_type, psb_dpk_,  &
+           & psb_ipk_, psb_lpk_, psb_epk_, amg_dml_parms, amg_daggr_data
+      implicit none
+      class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
+      type(amg_dml_parms), intent(inout)   :: parms 
+      type(amg_daggr_data), intent(in)     :: ag_data
+      type(psb_dspmat_type), intent(inout) :: a
+      type(psb_desc_type), intent(inout)   :: desc_a
+      integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
+      type(psb_ldspmat_type), intent(out)  :: t_prol
+      integer(psb_ipk_), intent(out)      :: info
+    end subroutine amg_d_newmatch_aggregator_build_tprol
+  end interface
+
+  interface
+    subroutine  amg_d_newmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
+         & ac,desc_ac,op_prol,op_restr,t_prol,info)
+      import :: amg_d_newmatch_aggregator_type, psb_desc_type, &
+           & psb_dspmat_type, psb_ldspmat_type, psb_dpk_,  &
+           & psb_ipk_, psb_lpk_, psb_epk_, amg_dml_parms
+      implicit none
+      class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
+      type(amg_dml_parms), intent(inout)    :: parms 
+      type(psb_dspmat_type), intent(in)     :: a
+      type(psb_desc_type), intent(inout)    :: desc_a
+      integer(psb_lpk_), intent(inout)      :: ilaggr(:), nlaggr(:)
+      type(psb_dspmat_type), intent(out)    :: op_prol,ac,op_restr
+      type(psb_ldspmat_type), intent(inout) :: t_prol
+      type(psb_desc_type), intent(inout)    :: desc_ac
+      integer(psb_ipk_), intent(out)        :: info
+    end subroutine amg_d_newmatch_aggregator_mat_bld
+  end interface
+
+  interface
+    subroutine  amg_d_newmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
+         & ac,desc_ac, op_prol,op_restr,info)
+      import :: amg_d_newmatch_aggregator_type, psb_desc_type, &
+           & psb_dspmat_type, psb_ldspmat_type, psb_dpk_,  &
+           & psb_ipk_, psb_lpk_, psb_epk_, amg_dml_parms
+      implicit none
+      class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
+      type(amg_dml_parms), intent(inout)    :: parms 
+      type(psb_dspmat_type), intent(in)     :: a
+      type(psb_desc_type), intent(inout)    :: desc_a
+      type(psb_dspmat_type), intent(inout) :: op_prol,ac,op_restr
+      type(psb_desc_type), intent(inout)     :: desc_ac
+      integer(psb_ipk_), intent(out)        :: info
+    end subroutine amg_d_newmatch_aggregator_mat_asb
+  end interface  
+  
+
+  interface
+    subroutine amg_d_newmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr, op_prol,info)
+      import :: amg_d_newmatch_aggregator_type, psb_desc_type, &
+           & psb_dspmat_type, psb_ldspmat_type, psb_dpk_,  &
+           & psb_ipk_, psb_lpk_, psb_epk_, amg_dml_parms
+      implicit none
+      type(psb_desc_type), intent(in)    :: desc_a
+      integer(psb_lpk_), allocatable, intent(inout)  :: ilaggr(:),nlaggr(:)
+      real(psb_dpk_), allocatable, intent(inout)  :: valaggr(:)
+      type(psb_ldspmat_type), intent(out)  :: op_prol
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine amg_d_newmatch_map_to_tprol
+  end interface
+  
+  interface
+    subroutine amg_daggrmat_unsmth_spmm_asb(a,desc_a,ilaggr,nlaggr,parms,&
+         & ac,op_prol,op_restr,info)
+      import :: amg_d_newmatch_aggregator_type, psb_desc_type, &
+           & psb_dspmat_type, psb_ldspmat_type, psb_dpk_,  &
+           & psb_ipk_, psb_lpk_, psb_epk_, amg_dml_parms
+      implicit none
+      type(psb_dspmat_type), intent(in)        :: a
+      type(psb_desc_type), intent(in)            :: desc_a
+      integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
+      type(amg_dml_parms), intent(inout)      :: parms 
+      type(psb_ldspmat_type), intent(inout)     :: op_prol
+      type(psb_ldspmat_type), intent(out)       :: ac,op_restr
+      integer(psb_ipk_), intent(out)             :: info
+    end subroutine amg_daggrmat_unsmth_spmm_asb
+  end interface
+
+  interface
+    subroutine  amg_d_newmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
+         & ac,desc_ac, op_prol,op_restr,info)
+      import :: amg_d_newmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
+           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
+      implicit none
+      class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
+      type(amg_dml_parms), intent(inout)    :: parms
+      type(psb_dspmat_type), intent(in)     :: a
+      type(psb_desc_type), intent(in)       :: desc_a
+      type(psb_dspmat_type), intent(inout) :: op_prol,op_restr
+      type(psb_dspmat_type), intent(inout)  :: ac
+      type(psb_desc_type), intent(inout)    :: desc_ac
+      integer(psb_ipk_), intent(out)        :: info
+    end subroutine amg_d_newmatch_aggregator_inner_mat_asb
+  end interface
+
+  
+!!$  interface
+!!$    subroutine amg_d_newmatch_unsmth_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
+!!$         & ac,desc_ac,op_prol,op_restr,t_prol,info)
+!!$      import :: amg_d_newmatch_aggregator_type, psb_desc_type, &
+!!$           & psb_dspmat_type, psb_ldspmat_type, psb_dpk_,  &
+!!$           & psb_ipk_, psb_lpk_, psb_epk_, amg_dml_parms
+!!$      
+!!$      implicit none
+!!$      
+!!$      ! Arguments
+!!$      type(psb_dspmat_type), intent(in)        :: a
+!!$      type(psb_desc_type), intent(in)            :: desc_a
+!!$      integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
+!!$      type(amg_dml_parms), intent(inout)      :: parms 
+!!$      type(psb_ldspmat_type), intent(inout)     :: t_prol
+!!$      type(psb_dspmat_type), intent(inout)       :: op_prol,ac,op_restr
+!!$      type(psb_desc_type), intent(inout)    :: desc_ac
+!!$      integer(psb_ipk_), intent(out)             :: info
+!!$    end subroutine amg_d_newmatch_unsmth_spmm_bld
+!!$  end interface
+
+  interface
+    subroutine amg_d_newmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
+         & ac,desc_ac,op_prol,op_restr,t_prol,info)
+      import :: amg_d_newmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
+           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
+      implicit none
+      type(psb_dspmat_type), intent(inout)    :: a
+      type(psb_desc_type), intent(inout)       :: desc_a
+      integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
+      type(amg_dml_parms), intent(inout)      :: parms
+      type(psb_ldspmat_type), intent(inout)   :: t_prol
+      type(psb_dspmat_type), intent(inout)    :: op_prol,ac, op_restr
+      type(psb_desc_type), intent(out)          :: desc_ac
+      integer(psb_ipk_), intent(out)          :: info
+    end subroutine amg_d_newmatch_spmm_bld_ov
+  end interface
+
+  interface
+    subroutine amg_d_newmatch_spmm_bld_inner(a,desc_a,ilaggr,nlaggr,parms,&
+         & ac,desc_ac,op_prol,op_restr,t_prol,info)
+      import :: amg_d_newmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
+           & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data,&
+           & psb_d_csr_sparse_mat, psb_ld_csr_sparse_mat
+      implicit none
+      type(psb_d_csr_sparse_mat), intent(inout) :: a
+      type(psb_desc_type), intent(inout)          :: desc_a
+      integer(psb_lpk_), intent(inout)          :: ilaggr(:), nlaggr(:)
+      type(amg_dml_parms), intent(inout)        :: parms
+      type(psb_ldspmat_type), intent(inout)     :: t_prol
+      type(psb_dspmat_type), intent(inout)      :: op_prol,ac, op_restr
+      type(psb_desc_type), intent(out)          :: desc_ac
+      integer(psb_ipk_), intent(out)            :: info
+    end subroutine amg_d_newmatch_spmm_bld_inner
+  end interface
+  
+  private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels
+  
+
+contains
+
+  subroutine d_bld_default_w(ag,nr)
+    use psb_realloc_mod
+    implicit none 
+    class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
+    integer(psb_ipk_), intent(in) :: nr
+    integer(psb_ipk_) :: info
+    call psb_realloc(nr,ag%w,info)
+    if (info /= psb_success_) return
+    ag%w = done
+    call ag%set_c_default_w()
+  end subroutine d_bld_default_w
+
+  subroutine d_set_default_nwm_w(ag)
+    use psb_realloc_mod
+    use iso_c_binding
+    implicit none 
+    class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
+    integer(psb_ipk_) :: info
+    
+    call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
+    ag%w_c_nxt%size      = psb_size(ag%w_nxt)
+    ag%w_c_nxt%owns_data = 0
+    if (ag%w_c_nxt%size > 0) call set_cloc(ag%w_nxt, ag%w_c_nxt)
+
+  end subroutine d_set_default_nwm_w
+
+  subroutine set_cloc(vect,w_c_nxt)
+    use iso_c_binding
+    real(psb_dpk_), target :: vect(:)
+    type(nwm_Vector) :: w_c_nxt
+    
+    w_c_nxt%data = c_loc(vect)
+  end subroutine set_cloc
+
+
+  subroutine d_newmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
+    use psb_realloc_mod
+    implicit none 
+    class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
+    integer(psb_lpk_), intent(in)  :: ilaggr(:)
+    real(psb_dpk_), intent(in)     :: valaggr(:)
+    integer(psb_ipk_), intent(in)  :: nx
+
+    integer(psb_ipk_) :: info,i,j
+
+    ! The vector was already fixed in the call to Newmatch.
+    call psb_realloc(nx,ag%w_nxt,info)
+    
+  end subroutine d_newmatch_bld_wnxt
+  
+  function d_newmatch_aggregator_fmt() result(val)
+    implicit none 
+    character(len=32)  :: val
+
+    val = "new matching aggregation"
+  end function d_newmatch_aggregator_fmt
+
+  subroutine  d_newmatch_aggregator_descr(ag,parms,iout,info,prefix)
+    implicit none 
+    class(amg_d_newmatch_aggregator_type), intent(in) :: ag
+    type(amg_dml_parms), intent(in)   :: parms
+    integer(psb_ipk_), intent(in)  :: iout
+    integer(psb_ipk_), intent(out) :: info
+    character(len=*), intent(in), optional  :: prefix
+    character(1024)    :: prefix_
+    if (present(prefix)) then
+      prefix_ = prefix
+    else
+      prefix_ = ""
+    end if
+
+    write(iout,*) trim(prefix_),' ','NewMatch Aggregator'
+    write(iout,*) trim(prefix_),' ','   Number of Matching   sweeps: ',ag%n_sweeps
+    write(iout,*) trim(prefix_),' ','   Matching algorithm         : ',ag%matching_alg
+    write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
+    call parms%mldescr(iout,info)
+    
+    return
+  end subroutine d_newmatch_aggregator_descr
+
+  function is_legal_malg(alg) result(val)
+    logical :: val
+    integer(psb_ipk_) :: alg
+
+    val = ((0<=alg).and.(alg<=2))
+  end function is_legal_malg
+
+  function is_legal_csize(csize) result(val)
+    logical :: val
+    integer(psb_ipk_) :: csize
+
+    val = ((-1==csize).or.(csize >0))
+  end function is_legal_csize
+
+  function is_legal_nsweeps(nsw) result(val)
+    logical :: val
+    integer(psb_ipk_) :: nsw
+
+    val = (1<=nsw)
+  end function is_legal_nsweeps
+
+  function is_legal_nlevels(nlv) result(val)
+    logical :: val
+    integer(psb_ipk_) :: nlv
+
+    val = (1<=nlv)
+  end function is_legal_nlevels
+  
+  subroutine  d_newmatch_aggregator_update_next(ag,agnext,info)
+    use psb_realloc_mod
+    implicit none 
+    class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
+    class(amg_d_base_aggregator_type), target, intent(inout) :: agnext
+    integer(psb_ipk_), intent(out)       :: info
+
+    !
+    !
+    select type(agnext)
+    class is (amg_d_newmatch_aggregator_type)
+      if (.not.is_legal_malg(agnext%matching_alg)) &
+           & agnext%matching_alg = ag%matching_alg
+      if (.not.is_legal_nsweeps(agnext%n_sweeps))&
+           & agnext%n_sweeps     = ag%n_sweeps 
+      if (.not.is_legal_csize(agnext%max_csize))&
+           & agnext%max_csize    = ag%max_csize 
+      if (.not.is_legal_nlevels(agnext%max_nlevels))&
+           & agnext%max_nlevels  = ag%max_nlevels
+      ! Is this going to generate shallow copies/memory leaks/double frees?
+      ! To be investigated further.
+      call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
+      call agnext%set_c_default_w()
+    class default
+      ! What should we do here? 
+    end select
+    info = 0 
+  end subroutine d_newmatch_aggregator_update_next
+
+  
+  subroutine amg_d_newmatch_aggr_csetr(ag,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_d_newmatch_aggregator_type), intent(inout) :: ag
+    character(len=*), intent(in)               :: what
+    real(psb_dpk_), intent(in)                 :: val
+    integer(psb_ipk_), intent(out)             :: info
+    integer(psb_ipk_), intent(in), optional    :: idx
+    integer(psb_ipk_)  :: err_act, iwhat
+    character(len=20)  :: name='d_newmatch_aggr_csetr'
+    info = psb_success_
+
+    ! For now we ignore IDX
+
+    select case(psb_toupper(trim(what)))
+    case('NWM_LAMBDA')
+      ag%lambda = val
+    case default
+      ! Do nothing
+    end select
+    return
+  end subroutine amg_d_newmatch_aggr_csetr
+  
+  subroutine amg_d_newmatch_aggr_csetc(ag,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_d_newmatch_aggregator_type), intent(inout) :: ag
+    character(len=*), intent(in)                  :: what
+    character(len=*), intent(in)                 :: val
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_), intent(in), optional       :: idx
+    integer(psb_ipk_)  :: err_act, iwhat
+    character(len=20)  :: name='d_newmatch_aggr_csetc'
+    info = psb_success_
+
+    ! For now we ignore IDX
+
+    select case(psb_toupper(trim(what)))
+    case('NWM_PARALLEL_MATCHING')
+      select case(psb_toupper(trim(val)))
+      case('SEQUENTIAL','F','FALSE')
+        ag%parallel_matching = .false.
+      case('PARALLEL','TRUE','T')
+        ag%parallel_matching =.true.
+      end select
+    case('NWM_REPRODUCIBLE_MATCHING')
+      select case(psb_toupper(trim(val)))
+      case('F','FALSE')
+        ag%reproducible_matching = .false.
+      case('REPRODUCIBLE','TRUE','T')
+        ag%reproducible_matching =.true.
+      end select
+    case('NWM_NEED_SYMMETRIZE')
+      select case(psb_toupper(trim(val)))
+      case('FALSE','F')
+        ag%need_symmetrize = .false.
+      case('SYMMETRIZE','TRUE','T')
+        ag%need_symmetrize =.true.
+      end select
+    case('NWM_UNSMOOTHED_HIERARCHY')
+      select case(psb_toupper(trim(val)))
+      case('F','FALSE')
+        ag%unsmoothed_hierarchy = .false.
+      case('T','TRUE')
+        ag%unsmoothed_hierarchy =.true.
+      end select
+    case default
+      ! Do nothing
+    end select
+    return
+  end subroutine amg_d_newmatch_aggr_csetc
+  
+  subroutine d_newmatch_aggr_cseti(ag,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_d_newmatch_aggregator_type), intent(inout) :: ag
+    character(len=*), intent(in)                  :: what
+    integer(psb_ipk_), intent(in)                 :: val
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_), intent(in), optional       :: idx
+    integer(psb_ipk_)  :: err_act, iwhat
+    character(len=20)  :: name='d_newmatch_aggr_cseti'
+    info = psb_success_
+
+    ! For now we ignore IDX
+    
+    select case(psb_toupper(trim(what)))
+    case('NWM_MATCH_ALG','NWM_MATCHING_ALG')
+      ag%matching_alg = val
+    case('NWM_SWEEPS')
+      ag%n_sweeps=val
+    case('NWM_MAX_CSIZE')
+      ag%max_csize = val
+    case('NWM_MAX_NLEVELS')
+      ag%max_nlevels = val
+    case('NWM_W_SIZE')
+      call ag%bld_default_w(val)
+    case('AGGR_SIZE')
+      ag%orig_aggr_size = val
+      ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
+    case default
+      ! Do nothing
+    end select
+    return
+  end subroutine d_newmatch_aggr_cseti
+
+  subroutine d_newmatch_aggr_set_default(ag)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_d_newmatch_aggregator_type), intent(inout) :: ag
+    character(len=20)  :: name='d_newmatch_aggr_set_default'
+    ag%matching_alg = 1
+    ag%n_sweeps     = 1
+    ag%max_nlevels  = 36
+    ag%max_csize    = -1
+    ag%lambda       = -1
+    !
+    ! Apparently newMatch works better
+    ! by keeping all entries
+    ! 
+    ag%do_clean_zeros = .false.
+
+    return
+
+  end subroutine d_newmatch_aggr_set_default
+
+  subroutine  d_newmatch_aggregator_free(ag,info)
+    use iso_c_binding
+    implicit none 
+    class(amg_d_newmatch_aggregator_type), intent(inout) :: ag
+    integer(psb_ipk_), intent(out)       :: info
+
+    info = 0
+    if (allocated(ag%w)) deallocate(ag%w,stat=info)
+    if (info /= 0) return
+    if (allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info)
+    if (info /= 0) return
+    ag%w_c_nxt%size = 0
+    ag%w_c_nxt%data = c_null_ptr
+    ag%w_c_nxt%owns_data = 0
+  end subroutine d_newmatch_aggregator_free
+
+  subroutine  d_newmatch_aggregator_clone(ag,agnext,info)
+    implicit none 
+    class(amg_d_newmatch_aggregator_type), intent(inout) :: ag
+    class(amg_d_base_aggregator_type), allocatable, intent(inout) :: agnext
+    integer(psb_ipk_), intent(out)       :: info
+
+    info = 0 
+    if (allocated(agnext)) then
+      call agnext%free(info)
+      if (info == 0) deallocate(agnext,stat=info)
+    end if
+    if (info /= 0) return
+    allocate(agnext,source=ag,stat=info)
+    select type(agnext)
+    class is (amg_d_newmatch_aggregator_type)
+      call agnext%set_c_default_w()
+    class default
+      ! Should never ever get here
+      info = -1
+    end select
+  end subroutine d_newmatch_aggregator_clone  
+  
+end module amg_d_newmatch_aggregator_mod

amgprec/amg_d_onelev_mod.f90

@@ -57,6 +57,7 @@ module amg_d_onelev_mod
   use amg_d_base_smoother_mod
   use amg_d_dec_aggregator_mod
   use amg_d_parmatch_aggregator_mod
+  use amg_d_newmatch_aggregator_mod
 
   use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, &
        & psb_d_base_vect_type, psb_ldspmat_type,  psb_dlinmap_type, psb_dpk_, &
@@ -188,10 +189,8 @@ module amg_d_onelev_mod
     procedure, pass(lv) :: clone   => d_base_onelev_clone
     procedure, pass(lv) :: cnv     => amg_d_base_onelev_cnv
     procedure, pass(lv) :: descr   => amg_d_base_onelev_descr
-    procedure, pass(lv) :: memory_use  => amg_d_base_onelev_memory_use
     procedure, pass(lv) :: default => d_base_onelev_default
     procedure, pass(lv) :: free    => amg_d_base_onelev_free
-    procedure, pass(lv) :: free_smoothers => amg_d_base_onelev_free_smoothers
     procedure, pass(lv) :: nullify => d_base_onelev_nullify
     procedure, pass(lv) :: check => amg_d_base_onelev_check
     procedure, pass(lv) :: dump  => amg_d_base_onelev_dump
@@ -275,23 +274,6 @@ module amg_d_onelev_mod
     end subroutine amg_d_base_onelev_descr
   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
-      Implicit None
-      ! Arguments
-      class(amg_d_onelev_type), intent(in)    :: lv
-      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_d_base_onelev_memory_use
-  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_, &
@@ -305,7 +287,7 @@ module amg_d_onelev_mod
     end subroutine amg_d_base_onelev_cnv
   end interface
 
-  interface
+interface
     subroutine amg_d_base_onelev_free(lv,info)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
            & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
@@ -317,18 +299,6 @@ module amg_d_onelev_mod
     end subroutine amg_d_base_onelev_free
   end interface
 
-  interface
-    subroutine amg_d_base_onelev_free_smoothers(lv,info)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
-      implicit none
-
-      class(amg_d_onelev_type), intent(inout) :: lv
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_d_base_onelev_free_smoothers
-  end interface
-
   interface
     subroutine amg_d_base_onelev_check(lv,info)
       import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &

amgprec/amg_d_parmatch_aggregator_mod.F90

@@ -244,12 +244,11 @@ module amg_d_parmatch_aggregator_mod
   end interface
 
   interface
-    subroutine amg_d_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_d_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
          & ac,desc_ac,op_prol,op_restr,t_prol,info)
       import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
            & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
       implicit none
-      integer(psb_ipk_), intent(in) :: dol1smoothing
       class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
       type(psb_dspmat_type), intent(in)       :: a
       type(psb_desc_type), intent(inout)      :: desc_a
@@ -263,12 +262,11 @@ module amg_d_parmatch_aggregator_mod
   end interface
 
   interface
-    subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
          & ac,desc_ac,op_prol,op_restr,t_prol,info)
       import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
            & psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
       implicit none
-      integer(psb_ipk_), intent(in) :: dol1smoothing
       class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
       type(psb_dspmat_type), intent(in)       :: a
       type(psb_desc_type), intent(inout)      :: desc_a

amgprec/amg_d_poly_coeff_mod.f90

@@ -1,548 +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
-!        Daniela di Serafino
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-!
-! File: amg_d_poly_smoother_mod.f90
-!
-! Module: amg_d_poly_smoother_mod
-!
-!  This module defines:
-!    the amg_d_poly_smoother_type data structure containing the
-!    smoother for a Jacobi/block Jacobi smoother.
-!  The smoother stores in ND the block off-diagonal matrix.
-!  One special case is treated separately, when the solver is DIAG or L1-DIAG
-!  then the ND is the entire off-diagonal part of the matrix (including the
-!  main diagonal block), so that it becomes possible to implement
-!  a pure Jacobi or L1-Jacobi global solver.
-!
-module amg_d_poly_coeff_mod
-  use psb_base_mod
-
-  real(psb_dpk_), parameter :: amg_d_poly_a_vect(30) = [ &
-       & 0.3333333333333333_psb_dpk_, &
-       & 0.1805359927403007_psb_dpk_, &
-       & 0.1159278464862213_psb_dpk_, &
-       & 0.0820780659590383_psb_dpk_, &
-       & 0.0618496002413377_psb_dpk_, &
-       & 0.0486605823426062_psb_dpk_, &
-       & 0.0395132986024057_psb_dpk_, &
-       & 0.0328701017544880_psb_dpk_, &
-       & 0.0278702862721800_psb_dpk_, &
-       & 0.0239987409600620_psb_dpk_, &
-       & 0.0209304400432259_psb_dpk_, &
-       & 0.0184513099045066_psb_dpk_, &
-       & 0.0164152586042591_psb_dpk_, &
-       & 0.0147195638076874_psb_dpk_, &
-       & 0.0132901324757843_psb_dpk_, &
-       & 0.0120723317737698_psb_dpk_, &
-       & 0.0110250964606384_psb_dpk_, &
-       & 0.0101170330064859_psb_dpk_, &
-       & 0.0093237789039835_psb_dpk_, &
-       & 0.0086261728849515_psb_dpk_, &
-       & 0.0080089618703679_psb_dpk_, &
-       & 0.0074598709610601_psb_dpk_, &
-       & 0.0069689238144320_psb_dpk_, &
-       & 0.0065279387776372_psb_dpk_, &
-       & 0.0061301503808627_psb_dpk_, &
-       & 0.0057699215598864_psb_dpk_, &
-       & 0.0054425224281914_psb_dpk_, &
-       & 0.0051439584672521_psb_dpk_, &
-       & 0.0048708358327268_psb_dpk_, &
-       & 0.0046202548314912_psb_dpk_ ];
-  
-  real(psb_dpk_), parameter :: amg_d_poly_beta_vect(900) = [ &
-       & 1.1250000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0238728757031315_psb_dpk_, 1.2640890537108553_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0084254478202830_psb_dpk_, 1.0886783920873087_psb_dpk_, &
-       & 1.3375312590961856_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0039131042728535_psb_dpk_, 1.0403581118859304_psb_dpk_, &
-       & 1.1486349854625493_psb_dpk_, 1.3826886924100055_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0021293014616472_psb_dpk_, 1.0217371154926094_psb_dpk_, &
-       & 1.0787243319260302_psb_dpk_, 1.1981006529266300_psb_dpk_, &
-       & 1.4132254279168215_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0012851725594023_psb_dpk_, 1.0130429303523338_psb_dpk_, &
-       & 1.0467821512411335_psb_dpk_, 1.1161648941967548_psb_dpk_, &
-       & 1.2382902021844453_psb_dpk_, 1.4352429710674484_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0008346439791242_psb_dpk_, 1.0084394943012289_psb_dpk_, &
-       & 1.0300870776871385_psb_dpk_, 1.0740838409200377_psb_dpk_, &
-       & 1.1503618670736642_psb_dpk_, 1.2711647404613990_psb_dpk_, &
-       & 1.4518665864936395_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0005724663119766_psb_dpk_, 1.0057742766241562_psb_dpk_, &
-       & 1.0205018792294143_psb_dpk_, 1.0501980344456543_psb_dpk_, &
-       & 1.1011557298494106_psb_dpk_, 1.1808604280685657_psb_dpk_, &
-       & 1.2983858538257604_psb_dpk_, 1.4648607315109978_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0004096007283281_psb_dpk_, 1.0041243950610661_psb_dpk_, &
-       & 1.0146021214826659_psb_dpk_, 1.0356111362667175_psb_dpk_, &
-       & 1.0713997252919425_psb_dpk_, 1.1268827371096291_psb_dpk_, &
-       & 1.2078521914072933_psb_dpk_, 1.3212193071674674_psb_dpk_, &
-       & 1.4752964282069962_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0003031222965291_psb_dpk_, 1.0030484066079688_psb_dpk_, &
-       & 1.0107702271538761_psb_dpk_, 1.0261901159764004_psb_dpk_, &
-       & 1.0523172493375519_psb_dpk_, 1.0925574320754976_psb_dpk_, &
-       & 1.1508337666397197_psb_dpk_, 1.2317225087089441_psb_dpk_, &
-       & 1.3406080202445980_psb_dpk_, 1.4838612440701109_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0002305859520939_psb_dpk_, 1.0023167502402850_psb_dpk_, &
-       & 1.0081724539630488_psb_dpk_, 1.0198298656634219_psb_dpk_, &
-       & 1.0395021023532465_psb_dpk_, 1.0696504270054137_psb_dpk_, &
-       & 1.1130575429574259_psb_dpk_, 1.1729087627556418_psb_dpk_, &
-       & 1.2528830057679230_psb_dpk_, 1.3572557991951903_psb_dpk_, &
-       & 1.4910167256413891_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0001794720082837_psb_dpk_, 1.0018018913961957_psb_dpk_, &
-       & 1.0063486190730762_psb_dpk_, 1.0153786456630600_psb_dpk_, &
-       & 1.0305694283076039_psb_dpk_, 1.0537601969394355_psb_dpk_, &
-       & 1.0869986259207296_psb_dpk_, 1.1325918309791341_psb_dpk_, &
-       & 1.1931627335817252_psb_dpk_, 1.2717129367511055_psb_dpk_, &
-       & 1.3716933796979953_psb_dpk_, 1.4970841857556243_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0001424192155957_psb_dpk_, 1.0014290693262966_psb_dpk_, &
-       & 1.0050302898629815_psb_dpk_, 1.0121691051849540_psb_dpk_, &
-       & 1.0241487434279255_psb_dpk_, 1.0423815888082042_psb_dpk_, &
-       & 1.0684200812870084_psb_dpk_, 1.1039901093675994_psb_dpk_, &
-       & 1.1510274824264566_psb_dpk_, 1.2117181191012512_psb_dpk_, &
-       & 1.2885426486512805_psb_dpk_, 1.3843261938099158_psb_dpk_, &
-       & 1.5022941875736890_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0001149053826193_psb_dpk_, 1.0011524637691460_psb_dpk_, &
-       & 1.0040535733326481_psb_dpk_, 1.0097959057315313_psb_dpk_, &
-       & 1.0194130047299461_psb_dpk_, 1.0340142503543679_psb_dpk_, &
-       & 1.0548059960662932_psb_dpk_, 1.0831142030181304_psb_dpk_, &
-       & 1.1204089166089239_psb_dpk_, 1.1683309565544606_psb_dpk_, &
-       & 1.2287212228823874_psb_dpk_, 1.3036530570781755_psb_dpk_, &
-       & 1.3954681405367855_psb_dpk_, 1.5068164620958386_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000940475075257_psb_dpk_, 1.0009429169634352_psb_dpk_, &
-       & 1.0033144905644482_psb_dpk_, 1.0080029483381612_psb_dpk_, &
-       & 1.0158423625914039_psb_dpk_, 1.0277208331770495_psb_dpk_, &
-       & 1.0445953542283146_psb_dpk_, 1.0675076120612534_psb_dpk_, &
-       & 1.0976009254588965_psb_dpk_, 1.1361385536615733_psb_dpk_, &
-       & 1.1845236142623621_psb_dpk_, 1.2443208730447588_psb_dpk_, &
-       & 1.3172806908339272_psb_dpk_, 1.4053654389356023_psb_dpk_, &
-       & 1.5107787250184523_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000779482817921_psb_dpk_, 1.0007812684725339_psb_dpk_, &
-       & 1.0027448797440124_psb_dpk_, 1.0066229101701514_psb_dpk_, &
-       & 1.0130985883697137_psb_dpk_, 1.0228944832933697_psb_dpk_, &
-       & 1.0367832140998394_psb_dpk_, 1.0555987571989653_psb_dpk_, &
-       & 1.0802484840556024_psb_dpk_, 1.1117260713149764_psb_dpk_, &
-       & 1.1511254343107276_psb_dpk_, 1.1996558461497355_psb_dpk_, &
-       & 1.2586584174494597_psb_dpk_, 1.3296241265666493_psb_dpk_, &
-       & 1.4142136069557629_psb_dpk_, 1.5142789173034623_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000653242183546_psb_dpk_, 1.0006545722939437_psb_dpk_, &
-       & 1.0022987777448662_psb_dpk_, 1.0055432691173583_psb_dpk_, &
-       & 1.0109550075016893_psb_dpk_, 1.0191301541168694_psb_dpk_, &
-       & 1.0307019481191382_psb_dpk_, 1.0463489778000818_psb_dpk_, &
-       & 1.0668039321569163_psb_dpk_, 1.0928629244731740_psb_dpk_, &
-       & 1.1253954850882542_psb_dpk_, 1.1653553270075827_psb_dpk_, &
-       & 1.2137919954743157_psb_dpk_, 1.2718635211544003_psb_dpk_, &
-       & 1.3408502062615073_psb_dpk_, 1.4221696838526183_psb_dpk_, &
-       & 1.5173934027630227_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000552858792859_psb_dpk_, 1.0005538659610900_psb_dpk_, &
-       & 1.0019444166743086_psb_dpk_, 1.0046864301776393_psb_dpk_, &
-       & 1.0092557508630260_psb_dpk_, 1.0161502674772371_psb_dpk_, &
-       & 1.0258958148322650_psb_dpk_, 1.0390523408953256_psb_dpk_, &
-       & 1.0562203973533295_psb_dpk_, 1.0780480145522537_psb_dpk_, &
-       & 1.1052380250439366_psb_dpk_, 1.1385559038570177_psb_dpk_, &
-       & 1.1788381980793483_psb_dpk_, 1.2270016234308427_psb_dpk_, &
-       & 1.2840529112630572_psb_dpk_, 1.3510994958895055_psb_dpk_, &
-       & 1.4293611393851839_psb_dpk_, 1.5201825990516680_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000472036358790_psb_dpk_, 1.0004728102642675_psb_dpk_, &
-       & 1.0016593577469159_psb_dpk_, 1.0039976891368516_psb_dpk_, &
-       & 1.0078911941833455_psb_dpk_, 1.0137601583069535_psb_dpk_, &
-       & 1.0220462561721002_psb_dpk_, 1.0332172281153209_psb_dpk_, &
-       & 1.0477717791157513_psb_dpk_, 1.0662447417325256_psb_dpk_, &
-       & 1.0892125464929936_psb_dpk_, 1.1172990456131733_psb_dpk_, &
-       & 1.1511817386833911_psb_dpk_, 1.1915984520803475_psb_dpk_, &
-       & 1.2393545273929878_psb_dpk_, 1.2953305781018039_psb_dpk_, &
-       & 1.3604908781568688_psb_dpk_, 1.4358924509939206_psb_dpk_, &
-       & 1.5226949329440265_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000406232569254_psb_dpk_, 1.0004068351374691_psb_dpk_, &
-       & 1.0014274431564170_psb_dpk_, 1.0034377175807407_psb_dpk_, &
-       & 1.0067826854070978_psb_dpk_, 1.0118204999571436_psb_dpk_, &
-       & 1.0189259121271075_psb_dpk_, 1.0284938700470616_psb_dpk_, &
-       & 1.0409432748132981_psb_dpk_, 1.0567209210598594_psb_dpk_, &
-       & 1.0763056524407055_psb_dpk_, 1.1002127636100871_psb_dpk_, &
-       & 1.1289986820268283_psb_dpk_, 1.1632659648787138_psb_dpk_, &
-       & 1.2036686486408621_psb_dpk_, 1.2509179912601627_psb_dpk_, &
-       & 1.3057886497146727_psb_dpk_, 1.3691253387497200_psb_dpk_, &
-       & 1.4418500199624611_psb_dpk_, 1.5249696741164267_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000352114440929_psb_dpk_, 1.0003525892395289_psb_dpk_, &
-       & 1.0012368357172980_psb_dpk_, 1.0029777430511673_psb_dpk_, &
-       & 1.0058727830027672_psb_dpk_, 1.0102297507781717_psb_dpk_, &
-       & 1.0163694815733537_psb_dpk_, 1.0246286588536329_psb_dpk_, &
-       & 1.0353627340015590_psb_dpk_, 1.0489489776835172_psb_dpk_, &
-       & 1.0657896841306789_psb_dpk_, 1.0863155505114006_psb_dpk_, &
-       & 1.1109892546943501_psb_dpk_, 1.1403092559728156_psb_dpk_, &
-       & 1.1748138447471401_psb_dpk_, 1.2150854687543668_psb_dpk_, &
-       & 1.2617553651999671_psb_dpk_, 1.3155085300984379_psb_dpk_, &
-       & 1.3770890582780710_psb_dpk_, 1.4473058898645985_psb_dpk_, &
-       & 1.5270390016420912_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000307198714835_psb_dpk_, 1.0003075769178242_psb_dpk_, &
-       & 1.0010787281022711_psb_dpk_, 1.0025963829693492_psb_dpk_, &
-       & 1.0051188625231162_psb_dpk_, 1.0089126974249720_psb_dpk_, &
-       & 1.0142547789760521_psb_dpk_, 1.0214345766593154_psb_dpk_, &
-       & 1.0307564364069204_psb_dpk_, 1.0425419742322541_psb_dpk_, &
-       & 1.0571325804249445_psb_dpk_, 1.0748920501551993_psb_dpk_, &
-       & 1.0962093570737961_psb_dpk_, 1.1215015873309027_psb_dpk_, &
-       & 1.1512170523743910_psb_dpk_, 1.1858385999327761_psb_dpk_, &
-       & 1.2258871437439198_psb_dpk_, 1.2719254338660289_psb_dpk_, &
-       & 1.3245620908078453_psb_dpk_, 1.3844559282498121_psb_dpk_, &
-       & 1.4523205908039656_psb_dpk_, 1.5289295350887884_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000269609460124_psb_dpk_, 1.0002699137181752_psb_dpk_, &
-       & 1.0009464748475532_psb_dpk_, 1.0022775198638552_psb_dpk_, &
-       & 1.0044888368184179_psb_dpk_, 1.0078128087804721_psb_dpk_, &
-       & 1.0124901352066715_psb_dpk_, 1.0187716022931539_psb_dpk_, &
-       & 1.0269199126829005_psb_dpk_, 1.0372115852204526_psb_dpk_, &
-       & 1.0499389358225151_psb_dpk_, 1.0654121509688057_psb_dpk_, &
-       & 1.0839614658147161_psb_dpk_, 1.1059394594887115_psb_dpk_, &
-       & 1.1317234807654135_psb_dpk_, 1.1617182180038959_psb_dpk_, &
-       & 1.1963584280123116_psb_dpk_, 1.2361118393501820_psb_dpk_, &
-       & 1.2814822465106404_psb_dpk_, 1.3330128124440397_psb_dpk_, &
-       & 1.3912895979940381_psb_dpk_, 1.4569453380258381_psb_dpk_, &
-       & 1.5306634853375161_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000237911597230_psb_dpk_, 1.0002381585998457_psb_dpk_, &
-       & 1.0008349974382460_psb_dpk_, 1.0020088476285827_psb_dpk_, &
-       & 1.0039582343156432_psb_dpk_, 1.0068870298152559_psb_dpk_, &
-       & 1.0110058445931565_psb_dpk_, 1.0165334547611182_psb_dpk_, &
-       & 1.0236982737890488_psb_dpk_, 1.0327398763510158_psb_dpk_, &
-       & 1.0439105824804926_psb_dpk_, 1.0574771105088172_psb_dpk_, &
-       & 1.0737223076000839_psb_dpk_, 1.0929469670793606_psb_dpk_, &
-       & 1.1154717421787756_psb_dpk_, 1.1416391663018148_psb_dpk_, &
-       & 1.1718157904303341_psb_dpk_, 1.2063944488757254_psb_dpk_, &
-       & 1.2457966652063013_psb_dpk_, 1.2904752108716941_psb_dpk_, &
-       & 1.3409168297942540_psb_dpk_, 1.3976451430108305_psb_dpk_, &
-       & 1.4612237483301715_psb_dpk_, 1.5322595309246121_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000210994601235_psb_dpk_, 1.0002111968041199_psb_dpk_, &
-       & 1.0007403694573151_psb_dpk_, 1.0017808593384865_psb_dpk_, &
-       & 1.0035081686576977_psb_dpk_, 1.0061021720448531_psb_dpk_, &
-       & 1.0097482505685551_psb_dpk_, 1.0146384533048582_psb_dpk_, &
-       & 1.0209726922414943_psb_dpk_, 1.0289599764553270_psb_dpk_, &
-       & 1.0388196916802268_psb_dpk_, 1.0507829315895938_psb_dpk_, &
-       & 1.0650938873538003_psb_dpk_, 1.0820113022982043_psb_dpk_, &
-       & 1.1018099987843295_psb_dpk_, 1.1247824847650900_psb_dpk_, &
-       & 1.1512406478277994_psb_dpk_, 1.1815175449359154_psb_dpk_, &
-       & 1.2159692965153148_psb_dpk_, 1.2549770940040335_psb_dpk_, &
-       & 1.2989493304988182_psb_dpk_, 1.3483238646890843_psb_dpk_, &
-       & 1.4035704288718982_psb_dpk_, 1.4651931924923849_psb_dpk_, &
-       & 1.5337334933563860_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000187989989242_psb_dpk_, 1.0001881567984481_psb_dpk_, &
-       & 1.0006595227084085_psb_dpk_, 1.0015861311895899_psb_dpk_, &
-       & 1.0031239047778964_psb_dpk_, 1.0054323694760092_psb_dpk_, &
-       & 1.0086755868504005_psb_dpk_, 1.0130231071421940_psb_dpk_, &
-       & 1.0186509477893992_psb_dpk_, 1.0257426018654052_psb_dpk_, &
-       & 1.0344900810652515_psb_dpk_, 1.0450949980170887_psb_dpk_, &
-       & 1.0577696928624343_psb_dpk_, 1.0727384092356933_psb_dpk_, &
-       & 1.0902385249817814_psb_dpk_, 1.1105218431816117_psb_dpk_, &
-       & 1.1338559493090710_psb_dpk_, 1.1605256406217599_psb_dpk_, &
-       & 1.1908344341913664_psb_dpk_, 1.2251061603103259_psb_dpk_, &
-       & 1.2636866483695495_psb_dpk_, 1.3069455126904677_psb_dpk_, &
-       & 1.3552780462128098_psb_dpk_, 1.4091072303921326_psb_dpk_, &
-       & 1.4688858701459975_psb_dpk_, 1.5350988632115488_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000168211938973_psb_dpk_, 1.0001683505351420_psb_dpk_, &
-       & 1.0005900360142315_psb_dpk_, 1.0014188084960041_psb_dpk_, &
-       & 1.0027938311393803_psb_dpk_, 1.0048572584314193_psb_dpk_, &
-       & 1.0077550080990554_psb_dpk_, 1.0116375492127350_psb_dpk_, &
-       & 1.0166607098595459_psb_dpk_, 1.0229865078405374_psb_dpk_, &
-       & 1.0307840079371537_psb_dpk_, 1.0402302093961155_psb_dpk_, &
-       & 1.0515109674005423_psb_dpk_, 1.0648219524284319_psb_dpk_, &
-       & 1.0803696515480321_psb_dpk_, 1.0983724158638981_psb_dpk_, &
-       & 1.1190615585080472_psb_dpk_, 1.1426825077681895_psb_dpk_, &
-       & 1.1694960201606786_psb_dpk_, 1.1997794584895700_psb_dpk_, &
-       & 1.2338281401870808_psb_dpk_, 1.2719567615042522_psb_dpk_, &
-       & 1.3145009034164739_psb_dpk_, 1.3618186254259919_psb_dpk_, &
-       & 1.4142921537855777_psb_dpk_, 1.4723296710339275_psb_dpk_, &
-       & 1.5363672141264497_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000151113991291_psb_dpk_, 1.0001512299115287_psb_dpk_, &
-       & 1.0005299814085029_psb_dpk_, 1.0012742317597600_psb_dpk_, &
-       & 1.0025087130476142_psb_dpk_, 1.0043606572645858_psb_dpk_, &
-       & 1.0069604400315522_psb_dpk_, 1.0104422369100252_psb_dpk_, &
-       & 1.0149446949285030_psb_dpk_, 1.0206116219981500_psb_dpk_, &
-       & 1.0275926969588451_psb_dpk_, 1.0360442030716124_psb_dpk_, &
-       & 1.0461297878595799_psb_dpk_, 1.0580212522952626_psb_dpk_, &
-       & 1.0718993724396861_psb_dpk_, 1.0879547567564958_psb_dpk_, &
-       & 1.1063887424550545_psb_dpk_, 1.1274143343577541_psb_dpk_, &
-       & 1.1512571899424711_psb_dpk_, 1.1781566543781672_psb_dpk_, &
-       & 1.2083668495540898_psb_dpk_, 1.2421578212983135_psb_dpk_, &
-       & 1.2798167491932815_psb_dpk_, 1.3216492236219661_psb_dpk_, &
-       & 1.3679805949228399_psb_dpk_, 1.4191573997915068_psb_dpk_, &
-       & 1.4755488703473389_psb_dpk_, 1.5375485315807513_psb_dpk_, &
-       & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000136257096588_psb_dpk_, 1.0001363546506836_psb_dpk_, &
-       & 1.0004778107488095_psb_dpk_, 1.0011486612681773_psb_dpk_, &
-       & 1.0022611433613271_psb_dpk_, 1.0039295964948667_psb_dpk_, &
-       & 1.0062710027404669_psb_dpk_, 1.0094055369479136_psb_dpk_, &
-       & 1.0134571288503909_psb_dpk_, 1.0185540391932908_psb_dpk_, &
-       & 1.0248294520252528_psb_dpk_, 1.0324220853457433_psb_dpk_, &
-       & 1.0414768223656390_psb_dpk_, 1.0521453657079123_psb_dpk_, &
-       & 1.0645869169533493_psb_dpk_, 1.0789688840227822_psb_dpk_, &
-       & 1.0954676189818162_psb_dpk_, 1.1142691889576817_psb_dpk_, &
-       & 1.1355701829701565_psb_dpk_, 1.1595785576006521_psb_dpk_, &
-       & 1.1865145245551894_psb_dpk_, 1.2166114833191515_psb_dpk_, &
-       & 1.2501170022543431_psb_dpk_, 1.2872938516530203_psb_dpk_, &
-       & 1.3284210924391027_psb_dpk_, 1.3737952243949607_psb_dpk_, &
-       & 1.4237313979931023_psb_dpk_, 1.4785646941265451_psb_dpk_, &
-       & 1.5386514762605854_psb_dpk_, 0.0000000000000000_psb_dpk_, &
-       & 1.0000123285767939_psb_dpk_, 1.0001233683396147_psb_dpk_, &
-       & 1.0004322711781202_psb_dpk_, 1.0010390719329101_psb_dpk_, &
-       & 1.0020451337350940_psb_dpk_, 1.0035535979966428_psb_dpk_, &
-       & 1.0056698406248343_psb_dpk_, 1.0085019360540697_psb_dpk_, &
-       & 1.0121611307132341_psb_dpk_, 1.0167623275769953_psb_dpk_, &
-       & 1.0224245834847208_psb_dpk_, 1.0292716209515502_psb_dpk_, &
-       & 1.0374323562422998_psb_dpk_, 1.0470414455308106_psb_dpk_, &
-       & 1.0582398510249318_psb_dpk_, 1.0711754290010183_psb_dpk_, &
-       & 1.0860035417614331_psb_dpk_, 1.1028876956049132_psb_dpk_, &
-       & 1.1220002069820316_psb_dpk_, 1.1435228990979547_psb_dpk_, &
-       & 1.1676478313209715_psb_dpk_, 1.1945780638597872_psb_dpk_, &
-       & 1.2245284602839432_psb_dpk_, 1.2577265305821996_psb_dpk_, &
-       & 1.2944133175813315_psb_dpk_, 1.3348443296857557_psb_dpk_, &
-       & 1.3792905230439911_psb_dpk_, 1.4280393364047606_psb_dpk_, &
-       & 1.4813957820911738_psb_dpk_, 1.5396835966986973_psb_dpk_ ]
-
-
-
-
-!!$  [1.1250000000000000_psb_dpk_, 0.0_psb_dpk_, 0.0_psb_dpk__psb_dpk_,,&
-!!$       & 1.0238728757031315_psb_dpk_, 1.2640890537108553_psb_dpk_,  0.0_psb_dpk_,&
-!!$       & 1.0084254478202830_psb_dpk_, 1.0886783920873087_psb_dpk_, 1.3375312590961856_psb_dpk_]
-
-  real(psb_dpk_), parameter  :: amg_d_poly_beta_mat(30,30)=reshape(amg_d_poly_beta_vect,[30,30])
-
-end module amg_d_poly_coeff_mod

amgprec/amg_d_poly_smoother.f90

@@ -1,374 +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
-!        Daniela di Serafino
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-!
-! File: amg_d_poly_smoother_mod.f90
-!
-! Module: amg_d_poly_smoother_mod
-!
-!  This module defines:
-!    the amg_d_poly_smoother_type data structure containing the
-!    smoother for a Jacobi/block Jacobi smoother.
-!  The smoother stores in ND the block off-diagonal matrix.
-!  One special case is treated separately, when the solver is DIAG or L1-DIAG
-!  then the ND is the entire off-diagonal part of the matrix (including the
-!  main diagonal block), so that it becomes possible to implement
-!  a pure Jacobi or L1-Jacobi global solver.
-!
-module amg_d_poly_smoother
-  use amg_d_base_smoother_mod
-  use amg_d_poly_coeff_mod
-  
-  type, extends(amg_d_base_smoother_type) :: amg_d_poly_smoother_type
-    ! The local solver component is inherited from the
-    ! parent type.
-    !    class(amg_d_base_solver_type), allocatable :: sv
-    !
-    integer(psb_ipk_)              :: pdegree, variant
-    integer(psb_ipk_)              :: rho_estimate=amg_poly_rho_est_power_
-    integer(psb_ipk_)              :: rho_estimate_iterations=10
-    type(psb_dspmat_type), pointer :: pa => null()
-    real(psb_dpk_), allocatable    :: poly_beta(:)
-    real(psb_dpk_)                 :: cf_a = dzero
-    real(psb_dpk_)                 :: rho_ba = -done
-  contains
-    procedure, pass(sm) :: apply_v => amg_d_poly_smoother_apply_vect
-!!$    procedure, pass(sm) :: apply_a => amg_d_poly_smoother_apply
-    procedure, pass(sm) :: dump    => amg_d_poly_smoother_dmp
-    procedure, pass(sm) :: build   => amg_d_poly_smoother_bld
-    procedure, pass(sm) :: cnv     => amg_d_poly_smoother_cnv
-    procedure, pass(sm) :: clone   => amg_d_poly_smoother_clone
-    procedure, pass(sm) :: clone_settings => amg_d_poly_smoother_clone_settings
-    procedure, pass(sm) :: clear_data     => amg_d_poly_smoother_clear_data  
-    procedure, pass(sm) :: free    => d_poly_smoother_free
-    procedure, pass(sm) :: cseti   => amg_d_poly_smoother_cseti
-    procedure, pass(sm) :: csetc   => amg_d_poly_smoother_csetc
-    procedure, pass(sm) :: csetr   => amg_d_poly_smoother_csetr
-    procedure, pass(sm) :: descr   => amg_d_poly_smoother_descr
-    procedure, pass(sm) :: sizeof  => d_poly_smoother_sizeof
-    procedure, pass(sm) :: default => d_poly_smoother_default
-    procedure, pass(sm) :: get_nzeros => d_poly_smoother_get_nzeros
-    procedure, pass(sm) :: get_wrksz => d_poly_smoother_get_wrksize
-    procedure, nopass   :: get_fmt    => d_poly_smoother_get_fmt
-    procedure, nopass   :: get_id     => d_poly_smoother_get_id
-  end type amg_d_poly_smoother_type
-  private :: d_poly_smoother_free, &
-       & d_poly_smoother_sizeof,  d_poly_smoother_get_nzeros, &
-       & d_poly_smoother_get_fmt, d_poly_smoother_get_id, &
-       & d_poly_smoother_get_wrksize
-
-
-  interface
-    subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
-         & 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_
-
-      type(psb_desc_type), intent(in)                 :: desc_data
-      class(amg_d_poly_smoother_type), intent(inout) :: sm
-      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
-      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
-      type(psb_d_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_d_poly_smoother_apply_vect
-  end interface
-
-!!$  interface
-!!$    subroutine amg_d_poly_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
-!!$         & sweeps,work,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_
-!!$      type(psb_desc_type), intent(in)      :: desc_data
-!!$      class(amg_d_poly_smoother_type), intent(inout) :: sm
-!!$      real(psb_dpk_),intent(inout)         :: x(:)
-!!$      real(psb_dpk_),intent(inout)         :: y(:)
-!!$      real(psb_dpk_),intent(in)            :: alpha,beta
-!!$      character(len=1),intent(in)           :: trans
-!!$      integer(psb_ipk_), intent(in)         :: sweeps
-!!$      real(psb_dpk_),target, intent(inout) :: work(:)
-!!$      integer(psb_ipk_), intent(out)        :: info
-!!$      character, intent(in), optional       :: init
-!!$      real(psb_dpk_),intent(inout), optional :: initu(:)
-!!$    end subroutine amg_d_poly_smoother_apply
-!!$  end interface
-!!$
-  
-  interface
-    subroutine amg_d_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
-      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_, psb_i_base_vect_type
-      type(psb_dspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a
-      class(amg_d_poly_smoother_type), intent(inout)       :: sm
-      integer(psb_ipk_), intent(out)                      :: info
-      class(psb_d_base_sparse_mat), intent(in), optional :: amold
-      class(psb_d_base_vect_type), intent(in), optional  :: vmold
-      class(psb_i_base_vect_type), intent(in), optional  :: imold
-    end subroutine amg_d_poly_smoother_bld
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_cnv(sm,info,amold,vmold,imold)
-      import :: amg_d_poly_smoother_type, psb_dpk_, &
-           & psb_d_base_sparse_mat, psb_d_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      class(amg_d_poly_smoother_type), intent(inout)       :: sm
-      integer(psb_ipk_), intent(out)                      :: info
-      class(psb_d_base_sparse_mat), intent(in), optional :: amold
-      class(psb_d_base_vect_type), intent(in), optional  :: vmold
-      class(psb_i_base_vect_type), intent(in), optional  :: imold
-    end subroutine amg_d_poly_smoother_cnv
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, &
-           & psb_ipk_
-      implicit none
-      class(amg_d_poly_smoother_type), intent(in) :: sm
-      type(psb_desc_type), intent(in)               :: desc
-      integer(psb_ipk_), intent(in)               :: level
-      integer(psb_ipk_), intent(out)              :: info
-      character(len=*), intent(in), optional :: prefix, head
-      logical, optional, intent(in)    :: smoother, solver, global_num
-    end subroutine amg_d_poly_smoother_dmp
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_clone(sm,smout,info)
-      import :: amg_d_poly_smoother_type, psb_dpk_, &
-           & amg_d_base_smoother_type, psb_ipk_
-      class(amg_d_poly_smoother_type), intent(inout)               :: sm
-      class(amg_d_base_smoother_type), allocatable, intent(inout) :: smout
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_d_poly_smoother_clone
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_clone_settings(sm,smout,info)
-      import :: amg_d_poly_smoother_type, psb_dpk_, &
-           & amg_d_base_smoother_type, psb_ipk_
-      class(amg_d_poly_smoother_type), intent(inout)               :: sm
-      class(amg_d_base_smoother_type), allocatable, intent(inout) :: smout
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_d_poly_smoother_clone_settings
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_clear_data(sm,info)
-      import :: amg_d_poly_smoother_type, psb_dpk_, &
-           & amg_d_base_smoother_type, psb_ipk_
-      class(amg_d_poly_smoother_type), intent(inout)               :: sm
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_d_poly_smoother_clear_data
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_descr(sm,info,iout,coarse,prefix)
-      import :: amg_d_poly_smoother_type, psb_ipk_
-      class(amg_d_poly_smoother_type), intent(in) :: sm
-      integer(psb_ipk_), intent(out)               :: info
-      integer(psb_ipk_), intent(in), optional      :: iout
-      logical, intent(in), optional                :: coarse
-      character(len=*), intent(in), optional       :: prefix
-    end subroutine amg_d_poly_smoother_descr
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_cseti(sm,what,val,info,idx)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_d_poly_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      integer(psb_ipk_), intent(in)                  :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_d_poly_smoother_cseti
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_csetc(sm,what,val,info,idx)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_d_poly_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      character(len=*), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_d_poly_smoother_csetc
-  end interface
-
-  interface
-    subroutine amg_d_poly_smoother_csetr(sm,what,val,info,idx)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_d_poly_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      real(psb_dpk_), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_d_poly_smoother_csetr
-  end interface
-
-
-contains
-
-
-  subroutine d_poly_smoother_free(sm,info)
-
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_poly_smoother_type), intent(inout) :: sm
-    integer(psb_ipk_), intent(out)                  :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20)  :: name='d_poly_smoother_free'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-
-
-    if (allocated(sm%sv)) then
-      call sm%sv%free(info)
-      if (info == psb_success_) deallocate(sm%sv,stat=info)
-      if (info /= psb_success_) then
-        info = psb_err_alloc_dealloc_
-        call psb_errpush(info,name)
-        goto 9999
-      end if
-    end if
-    if (allocated(sm%poly_beta))  deallocate(sm%poly_beta)
-    sm%pa => null()
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_poly_smoother_free
-
-  function d_poly_smoother_sizeof(sm) result(val)
-
-    implicit none
-    ! Arguments
-    class(amg_d_poly_smoother_type), intent(in) :: sm
-    integer(psb_epk_) :: val
-
-    val = psb_sizeof_dp
-    if (allocated(sm%sv)) val = val + sm%sv%sizeof()
-    if (allocated(sm%poly_beta)) val = val + psb_sizeof_dp * size(sm%poly_beta)
-
-    return
-  end function d_poly_smoother_sizeof
-
-  subroutine d_poly_smoother_default(sm)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_d_poly_smoother_type), intent(inout) :: sm
-
-    !
-    ! Default: BJAC with no residual check
-    !
-    sm%pdegree      = 1
-    sm%rho_ba       = -done
-    sm%variant      = amg_cheb_4_
-    sm%rho_estimate = amg_poly_rho_est_power_
-    sm%rho_estimate_iterations = 20
-    if (allocated(sm%sv)) then
-      call sm%sv%default()
-    end if
-
-    return
-  end subroutine d_poly_smoother_default
-
-  function d_poly_smoother_get_nzeros(sm) result(val)
-
-    implicit none
-    ! Arguments
-    class(amg_d_poly_smoother_type), intent(in) :: sm
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-
-    val = 0
-    if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()
-
-    return
-  end function d_poly_smoother_get_nzeros
-
-  function d_poly_smoother_get_wrksize(sm) result(val)
-    implicit none
-    class(amg_d_poly_smoother_type), intent(inout) :: sm
-    integer(psb_ipk_)  :: val
-
-    val = 4
-    if (allocated(sm%sv)) val = val + sm%sv%get_wrksz()
-
-  end function d_poly_smoother_get_wrksize
-
-  function d_poly_smoother_get_fmt() result(val)
-    implicit none
-    character(len=32)  :: val
-
-    val = "Polynomial smoother"
-  end function d_poly_smoother_get_fmt
-
-  function d_poly_smoother_get_id() result(val)
-    implicit none
-    integer(psb_ipk_)  :: val
-
-    val = amg_poly_
-  end function d_poly_smoother_get_id
-
-
-end module amg_d_poly_smoother

amgprec/amg_d_prec_type.f90

@@ -135,11 +135,8 @@ module amg_d_prec_type
     procedure, pass(prec)               :: build        => amg_dprecbld
     procedure, pass(prec)               :: hierarchy_build   => amg_d_hierarchy_bld
     procedure, pass(prec)               :: hierarchy_rebuild => amg_d_hierarchy_rebld
-    procedure, pass(prec)               :: hierarchy_free    => amg_d_hierarchy_free    
     procedure, pass(prec)               :: smoothers_build   => amg_d_smoothers_bld
-    procedure, pass(prec)               :: smoothers_free    => amg_d_smoothers_free
     procedure, pass(prec)               :: descr        =>  amg_dfile_prec_descr
-    procedure, pass(prec)               :: memory_use   =>  amg_dfile_prec_memory_use
   end type amg_dprec_type
 
   private :: amg_d_dump, amg_d_get_compl,  amg_d_cmp_compl,&
@@ -171,22 +168,6 @@ module amg_d_prec_type
     end subroutine amg_dfile_prec_descr
   end interface
 
-  
-  interface amg_memory_use
-    subroutine amg_dfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
-      import :: amg_dprec_type, psb_ipk_
-      implicit none
-      ! Arguments
-      class(amg_dprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: root
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_dfile_prec_memory_use
-  end interface
-
   interface amg_sizeof
     module procedure amg_dprec_sizeof
   end interface
@@ -364,14 +345,6 @@ module amg_d_prec_type
     end subroutine amg_d_smoothers_bld
   end interface amg_smoothers_bld
 
-  interface amg_smoothers_free
-    module procedure  amg_d_smoothers_free
-  end interface amg_smoothers_free
-
-  interface amg_hierarchy_free
-    module procedure amg_d_hierarchy_free
-  end interface amg_hierarchy_free
-
 contains
   !
   ! Function returning a pointer to the smoother
@@ -645,68 +618,6 @@ contains
 
   end subroutine amg_d_prec_free
 
-  subroutine amg_d_smoothers_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_dprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_d_smoothers_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
-        call prec%precv(i)%free_smoothers(info)
-      end do
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_d_smoothers_free
-
-  subroutine amg_d_hierarchy_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_dprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_d_hierarchy_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    me=-1
-    write(0,*) 'Missing implementation '
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_d_hierarchy_free
 
 
   !

amgprec/amg_s_ainv_solver.F90

@@ -58,7 +58,6 @@ module amg_s_ainv_solver
     procedure, pass(sv) :: check   => amg_s_ainv_solver_check
     procedure, pass(sv) :: build   => amg_s_ainv_solver_bld
     procedure, pass(sv) :: clone   => amg_s_ainv_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_s_ainv_solver_clone_settings
     procedure, pass(sv) :: cseti   => amg_s_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_s_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_s_ainv_solver_csetr
@@ -86,16 +85,6 @@ module amg_s_ainv_solver
     end subroutine amg_s_ainv_solver_clone
   end interface
 
-  interface
-    subroutine amg_s_ainv_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
-       & amg_s_base_solver_type, psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
-      Implicit None
-      class(amg_s_ainv_solver_type), intent(inout)              :: sv
-      class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_s_ainv_solver_clone_settings
-  end interface
 
   interface
     subroutine amg_s_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)

amgprec/amg_s_ilu_solver.f90

@@ -234,7 +234,7 @@ contains
     ! Arguments
     class(amg_s_ilu_solver_type), intent(inout) :: sv
 
-    sv%fact_type = amg_ilu_n_
+    sv%fact_type = psb_ilu_n_
     sv%fill_in   = 0
     sv%thresh    = szero
 
@@ -255,13 +255,13 @@ contains
     info = psb_success_
 
     call amg_check_def(sv%fact_type,&
-         & 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
+         & 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
 
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
+    case(psb_ilu_n_,psb_milu_n_)      
       call amg_check_def(sv%fill_in,&
            & 'Level',izero,is_int_non_negative)
-    case(amg_ilu_t_)                 
+    case(psb_ilu_t_)                 
       call amg_check_def(sv%thresh,&
            & 'Eps',szero,is_legal_s_fact_thrs)
     end select
@@ -439,9 +439,9 @@ contains
     write(iout_,*) trim(prefix_), '  Incomplete factorization solver: ',&
          &  amg_fact_names(sv%fact_type)
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
+    case(psb_ilu_n_,psb_milu_n_)      
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-    case(amg_ilu_t_)         
+    case(psb_ilu_t_)         
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
       write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
     end select
@@ -496,7 +496,7 @@ contains
     implicit none 
     integer(psb_ipk_)  :: val
     
-    val = amg_ilu_n_
+    val = psb_ilu_n_
   end function s_ilu_solver_get_id
 
   function s_ilu_solver_get_wrksize() result(val)

amgprec/amg_s_inner_mod.f90

@@ -109,12 +109,11 @@ module amg_s_inner_mod
   end interface amg_map_to_tprol
 
   abstract interface
-    subroutine amg_saggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_saggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
          & ac,desc_ac,op_prol,op_restr,t_prol,info)
       import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_, psb_lsspmat_type
       import ::  amg_s_onelev_type, amg_sml_parms
       implicit none 
-      integer(psb_ipk_), intent(in)               :: dol1smoothing
       type(psb_sspmat_type), intent(in)         :: a
       type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)            :: ilaggr(:), nlaggr(:)

amgprec/amg_s_invk_solver.f90

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

amgprec/amg_s_invt_solver.f90

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

amgprec/amg_s_jac_solver.f90

@@ -1,585 +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 written permission.
-!   
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
-!
-!
-! File: amg_s_jac_solver_mod.f90
-!
-! Module: amg_s_jac_solver_mod
-!
-!  This module defines: 
-!  - the amg_s_jac_solver_type data structure containing the ingredients
-!    for a local Jacobi  iteration. The iterations are local to a process
-!    (they operate on the block diagonal).
-!    
-!
-module amg_s_jac_solver
-
-  use amg_s_base_solver_mod
-
-  type, extends(amg_s_base_solver_type) :: amg_s_jac_solver_type
-    type(psb_sspmat_type)      :: a
-    type(psb_s_vect_type), allocatable :: dv
-    real(psb_spk_), allocatable        :: d(:)
-    integer(psb_ipk_)          :: sweeps
-    real(psb_spk_)             :: eps
-  contains
-    procedure, pass(sv) :: dump    => amg_s_jac_solver_dmp
-    procedure, pass(sv) :: check   => s_jac_solver_check
-    procedure, pass(sv) :: clone   => amg_s_jac_solver_clone
-    procedure, pass(sv) :: clone_settings => amg_s_jac_solver_clone_settings
-    procedure, pass(sv) :: clear_data     => amg_s_jac_solver_clear_data
-    procedure, pass(sv) :: build   => amg_s_jac_solver_bld
-    procedure, pass(sv) :: cnv     => amg_s_jac_solver_cnv
-    procedure, pass(sv) :: apply_v => amg_s_jac_solver_apply_vect
-    procedure, pass(sv) :: apply_a => amg_s_jac_solver_apply
-    procedure, pass(sv) :: free    => s_jac_solver_free
-    procedure, pass(sv) :: cseti   => s_jac_solver_cseti
-    procedure, pass(sv) :: csetc   => s_jac_solver_csetc
-    procedure, pass(sv) :: csetr   => s_jac_solver_csetr
-    procedure, pass(sv) :: descr   => s_jac_solver_descr
-    procedure, pass(sv) :: default => s_jac_solver_default
-    procedure, pass(sv) :: sizeof  => s_jac_solver_sizeof
-    procedure, pass(sv) :: get_nzeros => s_jac_solver_get_nzeros
-    procedure, nopass   :: get_wrksz  => s_jac_solver_get_wrksize
-    procedure, nopass   :: get_fmt    => s_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => s_jac_solver_get_id
-    procedure, nopass   :: is_iterative => s_jac_solver_is_iterative
-  end type amg_s_jac_solver_type
-
-  type, extends(amg_s_jac_solver_type) :: amg_s_l1_jac_solver_type
-  contains
-    procedure, pass(sv) :: build   => amg_s_l1_jac_solver_bld
-    procedure, pass(sv) :: descr   => s_l1_jac_solver_descr
-    procedure, nopass   :: get_fmt    => s_l1_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => s_l1_jac_solver_get_id
-  end type amg_s_l1_jac_solver_type
-
-
-  private :: s_jac_solver_bld, s_jac_solver_apply, &
-       &  s_jac_solver_free,   &
-       &  s_jac_solver_descr,  s_jac_solver_sizeof, &
-       &  s_jac_solver_default, s_jac_solver_dmp, &
-       &  s_jac_solver_apply_vect, s_jac_solver_get_nzeros, &
-       &  s_jac_solver_get_fmt, s_jac_solver_check,&
-       &  s_jac_solver_is_iterative, &
-       &  s_jac_solver_get_id, s_jac_solver_get_wrksize
-
-  interface 
-    subroutine amg_s_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,work,wv,info,init,initu)
-      import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
-           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)             :: desc_data
-      class(amg_s_jac_solver_type), intent(inout) :: sv
-      type(psb_s_vect_type),intent(inout)         :: x
-      type(psb_s_vect_type),intent(inout)         :: y
-      real(psb_spk_),intent(in)                    :: alpha,beta
-      character(len=1),intent(in)                   :: trans
-      real(psb_spk_),target, intent(inout)         :: work(:)
-      type(psb_s_vect_type),intent(inout)         :: wv(:)
-      integer(psb_ipk_), intent(out)                :: info
-      character, intent(in), optional                :: init
-      type(psb_s_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_s_jac_solver_apply_vect
-  end interface
-
-  interface 
-    subroutine amg_s_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
-      import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
-           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_s_jac_solver_type), intent(inout) :: sv
-      real(psb_spk_),intent(inout)         :: x(:)
-      real(psb_spk_),intent(inout)         :: y(:)
-      real(psb_spk_),intent(in)            :: alpha,beta
-      character(len=1),intent(in)           :: trans
-      real(psb_spk_),target, intent(inout) :: work(:)
-      integer(psb_ipk_), intent(out)        :: info
-      character, intent(in), optional       :: init
-      real(psb_spk_),intent(inout), optional :: initu(:)
-    end subroutine amg_s_jac_solver_apply
-  end interface
-
-  interface 
-    subroutine amg_s_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
-           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_sspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_s_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_sspmat_type), intent(in), target, optional :: b
-      class(psb_s_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_s_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional   :: imold
-    end subroutine amg_s_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_s_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_s_l1_jac_solver_type, psb_s_vect_type, psb_spk_, &
-           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_sspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_s_l1_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_sspmat_type), intent(in), target, optional :: b
-      class(psb_s_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_s_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional   :: imold
-    end subroutine amg_s_l1_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_s_jac_solver_cnv(sv,info,amold,vmold,imold)
-      import :: amg_s_jac_solver_type, psb_spk_, &
-           & psb_s_base_sparse_mat, psb_s_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      class(amg_s_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      class(psb_s_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_s_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional   :: imold
-    end subroutine amg_s_jac_solver_cnv
-  end interface
-  
-  interface 
-    subroutine amg_s_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
-      import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
-           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
-           & psb_ipk_
-      implicit none 
-      class(amg_s_jac_solver_type), intent(in) :: sv
-      type(psb_desc_type), intent(in)             :: desc
-      integer(psb_ipk_), intent(in)              :: level
-      integer(psb_ipk_), intent(out)             :: info
-      character(len=*), intent(in), optional     :: prefix, head
-      logical, optional, intent(in)              :: solver, global_num
-    end subroutine amg_s_jac_solver_dmp
-  end interface
-  
-  interface
-    subroutine amg_s_jac_solver_clone(sv,svout,info)
-      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
-           & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
-           & amg_s_base_solver_type, amg_s_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_s_jac_solver_type), intent(inout)               :: sv
-      class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)              :: info
-    end subroutine amg_s_jac_solver_clone
-  end interface
-  
-!!$  interface
-!!$    subroutine amg_s_l1_jac_solver_clone(sv,svout,info)
-!!$      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
-!!$           & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
-!!$           & amg_s_base_solver_type, amg_s_l1_jac_solver_type, psb_ipk_
-!!$      Implicit None
-!!$      
-!!$      ! Arguments
-!!$      class(amg_s_l1_jac_solver_type), intent(inout)               :: sv
-!!$      class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
-!!$      integer(psb_ipk_), intent(out)              :: info
-!!$    end subroutine amg_s_l1_jac_solver_clone
-!!$  end interface
-
-  interface
-    subroutine amg_s_jac_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
-           & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
-           & amg_s_base_solver_type, amg_s_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_s_jac_solver_type), intent(inout) :: sv
-      class(amg_s_base_solver_type), intent(inout) :: svout
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_s_jac_solver_clone_settings
-  end interface
-
-  interface
-    subroutine amg_s_jac_solver_clear_data(sv,info)
-      import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
-           & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
-           & amg_s_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_s_jac_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(out)                 :: info
-    end subroutine amg_s_jac_solver_clear_data
-  end interface
-
-contains
-
-  subroutine s_jac_solver_default(sv)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(inout) :: sv
-
-    sv%sweeps = ione
-    sv%eps    = dzero
-    
-    return
-  end subroutine s_jac_solver_default
-
-  subroutine s_jac_solver_check(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20) :: name='s_jac_solver_check'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call amg_check_def(sv%sweeps,&
-         & 'Jacobi sweeps',ione,is_int_positive)
-
-    if (info /= psb_success_) goto 9999
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine s_jac_solver_check
-
-  subroutine s_jac_solver_cseti(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    integer(psb_ipk_), intent(in)                 :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='s_jac_solver_cseti'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-    select case(psb_toupper(what))
-    case('SOLVER_SWEEPS')
-      sv%sweeps = val      
-    case default
-      call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_jac_solver_cseti
-
-  subroutine s_jac_solver_csetc(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(inout) :: sv
-    character(len=*), intent(in)                  :: what 
-    character(len=*), intent(in)                  :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act, ival
-    character(len=20)  :: name='s_jac_solver_csetc'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-
-    call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
-  
-    if (info /= psb_success_) then
-      info = psb_err_from_subroutine_
-      call psb_errpush(info, name)
-      goto 9999
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_jac_solver_csetc
-  
-  subroutine s_jac_solver_csetr(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    real(psb_spk_), intent(in)                     :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='s_jac_solver_csetr'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    select case(psb_toupper(what))
-    case('SOLVER_EPS') 
-      sv%eps = val
-    case default
-      call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_jac_solver_csetr
-
-  subroutine s_jac_solver_free(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='s_jac_solver_free'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call sv%a%free()
-    if (allocated(sv%dv)) then
-      call sv%dv%free(info)
-      deallocate(sv%dv)
-    end if
-    if (allocated(sv%d)) deallocate(sv%d)
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_jac_solver_free
-
-  subroutine s_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_s_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_jac_solver_descr
-
-  function s_jac_solver_get_nzeros(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-    
-    val = 0 
-    val = val + sv%a%get_nzeros()
-    val = val + sv%dv%get_nrows()
-
-    return
-  end function s_jac_solver_get_nzeros
-
-  function s_jac_solver_sizeof(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_s_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-
-    val = psb_sizeof_ip 
-    val = val + sv%a%sizeof()
-    val = val + sv%dv%sizeof()
-
-    return
-  end function s_jac_solver_sizeof
-
-  function s_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "Jacobi solver"
-  end function s_jac_solver_get_fmt
-
-  function s_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_jac_
-  end function s_jac_solver_get_id
-
-  !
-  ! If this is true, then the solver needs a starting
-  ! guess. Currently only handled in JAC smoother. 
-  ! 
-  function s_jac_solver_is_iterative() result(val)
-    implicit none 
-    logical  :: val
-
-    val = .true.
-  end function s_jac_solver_is_iterative
-    
-  function s_jac_solver_get_wrksize() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = 2
-  end function s_jac_solver_get_wrksize
-
-  subroutine s_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_l1_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_s_l1_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_l1_jac_solver_descr
-
-  function s_l1_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "L1-Jacobi solver"
-  end function s_l1_jac_solver_get_fmt
-
-  function s_l1_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_l1_jac_
-  end function s_l1_jac_solver_get_id
-  
-end module amg_s_jac_solver

amgprec/amg_s_mumps_solver.F90

@@ -78,8 +78,7 @@ module amg_s_mumps_solver
     !
     ! Controls to be set before MUMPS instantiation:
     !
-    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: 'LOCAL_SOLVER
-    !                            1==amg_global_solver_: 'GLOBAL_SOLVER'
+    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: LOCAL   1==amg_global_solver_: GLOBAL
     ! IPAR(2) : MUMPS_PRINT_ERR  print verbosity (see MUMPS)
     ! IPAR(3) : MUMPS_SYM        0: non-symmetric   2: symmetric
     integer(psb_ipk_), dimension(3) :: ipar

amgprec/amg_s_onelev_mod.f90

@@ -188,10 +188,8 @@ module amg_s_onelev_mod
     procedure, pass(lv) :: clone   => s_base_onelev_clone
     procedure, pass(lv) :: cnv     => amg_s_base_onelev_cnv
     procedure, pass(lv) :: descr   => amg_s_base_onelev_descr
-    procedure, pass(lv) :: memory_use  => amg_s_base_onelev_memory_use
     procedure, pass(lv) :: default => s_base_onelev_default
     procedure, pass(lv) :: free    => amg_s_base_onelev_free
-    procedure, pass(lv) :: free_smoothers => amg_s_base_onelev_free_smoothers
     procedure, pass(lv) :: nullify => s_base_onelev_nullify
     procedure, pass(lv) :: check => amg_s_base_onelev_check
     procedure, pass(lv) :: dump  => amg_s_base_onelev_dump
@@ -275,23 +273,6 @@ module amg_s_onelev_mod
     end subroutine amg_s_base_onelev_descr
   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
-      Implicit None
-      ! Arguments
-      class(amg_s_onelev_type), intent(in)    :: lv
-      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_s_base_onelev_memory_use
-  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_, &
@@ -305,7 +286,7 @@ module amg_s_onelev_mod
     end subroutine amg_s_base_onelev_cnv
   end interface
 
-  interface
+interface
     subroutine amg_s_base_onelev_free(lv,info)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
            & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
@@ -317,18 +298,6 @@ module amg_s_onelev_mod
     end subroutine amg_s_base_onelev_free
   end interface
 
-  interface
-    subroutine amg_s_base_onelev_free_smoothers(lv,info)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
-      implicit none
-
-      class(amg_s_onelev_type), intent(inout) :: lv
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_s_base_onelev_free_smoothers
-  end interface
-
   interface
     subroutine amg_s_base_onelev_check(lv,info)
       import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &

amgprec/amg_s_parmatch_aggregator_mod.F90

@@ -244,12 +244,11 @@ module amg_s_parmatch_aggregator_mod
   end interface
 
   interface
-    subroutine amg_s_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_s_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
          & ac,desc_ac,op_prol,op_restr,t_prol,info)
       import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
            & psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
       implicit none
-      integer(psb_ipk_), intent(in) :: dol1smoothing
       class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
       type(psb_sspmat_type), intent(in)       :: a
       type(psb_desc_type), intent(inout)      :: desc_a
@@ -263,12 +262,11 @@ module amg_s_parmatch_aggregator_mod
   end interface
 
   interface
-    subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
          & ac,desc_ac,op_prol,op_restr,t_prol,info)
       import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
            & psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
       implicit none
-      integer(psb_ipk_), intent(in) :: dol1smoothing
       class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
       type(psb_sspmat_type), intent(in)       :: a
       type(psb_desc_type), intent(inout)      :: desc_a

amgprec/amg_s_poly_smoother.f90

@@ -1,374 +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
-!        Daniela di Serafino
-!
-!    Redistribution and use in source and binary forms, with or without
-!    modification, are permitted provided that the following conditions
-!    are met:
-!      1. Redistributions of source code must retain the above copyright
-!         notice, this list of conditions and the following disclaimer.
-!      2. Redistributions in binary form must reproduce the above copyright
-!         notice, this list of conditions, and the following disclaimer in the
-!         documentation and/or other materials provided with the distribution.
-!      3. The name of the AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific written permission.
-!
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!
-!
-!
-! File: amg_s_poly_smoother_mod.f90
-!
-! Module: amg_s_poly_smoother_mod
-!
-!  This module defines:
-!    the amg_s_poly_smoother_type data structure containing the
-!    smoother for a Jacobi/block Jacobi smoother.
-!  The smoother stores in ND the block off-diagonal matrix.
-!  One special case is treated separately, when the solver is DIAG or L1-DIAG
-!  then the ND is the entire off-diagonal part of the matrix (including the
-!  main diagonal block), so that it becomes possible to implement
-!  a pure Jacobi or L1-Jacobi global solver.
-!
-module amg_s_poly_smoother
-  use amg_s_base_smoother_mod
-  use amg_d_poly_coeff_mod
-  
-  type, extends(amg_s_base_smoother_type) :: amg_s_poly_smoother_type
-    ! The local solver component is inherited from the
-    ! parent type.
-    !    class(amg_s_base_solver_type), allocatable :: sv
-    !
-    integer(psb_ipk_)              :: pdegree, variant
-    integer(psb_ipk_)              :: rho_estimate=amg_poly_rho_est_power_
-    integer(psb_ipk_)              :: rho_estimate_iterations=10
-    type(psb_sspmat_type), pointer :: pa => null()
-    real(psb_spk_), allocatable    :: poly_beta(:)
-    real(psb_spk_)                 :: cf_a = szero
-    real(psb_spk_)                 :: rho_ba = -sone
-  contains
-    procedure, pass(sm) :: apply_v => amg_s_poly_smoother_apply_vect
-!!$    procedure, pass(sm) :: apply_a => amg_s_poly_smoother_apply
-    procedure, pass(sm) :: dump    => amg_s_poly_smoother_dmp
-    procedure, pass(sm) :: build   => amg_s_poly_smoother_bld
-    procedure, pass(sm) :: cnv     => amg_s_poly_smoother_cnv
-    procedure, pass(sm) :: clone   => amg_s_poly_smoother_clone
-    procedure, pass(sm) :: clone_settings => amg_s_poly_smoother_clone_settings
-    procedure, pass(sm) :: clear_data     => amg_s_poly_smoother_clear_data  
-    procedure, pass(sm) :: free    => s_poly_smoother_free
-    procedure, pass(sm) :: cseti   => amg_s_poly_smoother_cseti
-    procedure, pass(sm) :: csetc   => amg_s_poly_smoother_csetc
-    procedure, pass(sm) :: csetr   => amg_s_poly_smoother_csetr
-    procedure, pass(sm) :: descr   => amg_s_poly_smoother_descr
-    procedure, pass(sm) :: sizeof  => s_poly_smoother_sizeof
-    procedure, pass(sm) :: default => s_poly_smoother_default
-    procedure, pass(sm) :: get_nzeros => s_poly_smoother_get_nzeros
-    procedure, pass(sm) :: get_wrksz => s_poly_smoother_get_wrksize
-    procedure, nopass   :: get_fmt    => s_poly_smoother_get_fmt
-    procedure, nopass   :: get_id     => s_poly_smoother_get_id
-  end type amg_s_poly_smoother_type
-  private :: s_poly_smoother_free, &
-       & s_poly_smoother_sizeof,  s_poly_smoother_get_nzeros, &
-       & s_poly_smoother_get_fmt, s_poly_smoother_get_id, &
-       & s_poly_smoother_get_wrksize
-
-
-  interface
-    subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
-         & 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_
-
-      type(psb_desc_type), intent(in)                 :: desc_data
-      class(amg_s_poly_smoother_type), intent(inout) :: sm
-      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
-      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
-      type(psb_s_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_s_poly_smoother_apply_vect
-  end interface
-
-!!$  interface
-!!$    subroutine amg_s_poly_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
-!!$         & sweeps,work,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_
-!!$      type(psb_desc_type), intent(in)      :: desc_data
-!!$      class(amg_s_poly_smoother_type), intent(inout) :: sm
-!!$      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
-!!$      integer(psb_ipk_), intent(in)         :: sweeps
-!!$      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_poly_smoother_apply
-!!$  end interface
-!!$
-  
-  interface
-    subroutine amg_s_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
-      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_, psb_i_base_vect_type
-      type(psb_sspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a
-      class(amg_s_poly_smoother_type), intent(inout)       :: sm
-      integer(psb_ipk_), intent(out)                      :: info
-      class(psb_s_base_sparse_mat), intent(in), optional :: amold
-      class(psb_s_base_vect_type), intent(in), optional  :: vmold
-      class(psb_i_base_vect_type), intent(in), optional  :: imold
-    end subroutine amg_s_poly_smoother_bld
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_cnv(sm,info,amold,vmold,imold)
-      import :: amg_s_poly_smoother_type, psb_spk_, &
-           & psb_s_base_sparse_mat, psb_s_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      class(amg_s_poly_smoother_type), intent(inout)       :: sm
-      integer(psb_ipk_), intent(out)                      :: info
-      class(psb_s_base_sparse_mat), intent(in), optional :: amold
-      class(psb_s_base_vect_type), intent(in), optional  :: vmold
-      class(psb_i_base_vect_type), intent(in), optional  :: imold
-    end subroutine amg_s_poly_smoother_cnv
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, &
-           & psb_ipk_
-      implicit none
-      class(amg_s_poly_smoother_type), intent(in) :: sm
-      type(psb_desc_type), intent(in)               :: desc
-      integer(psb_ipk_), intent(in)               :: level
-      integer(psb_ipk_), intent(out)              :: info
-      character(len=*), intent(in), optional :: prefix, head
-      logical, optional, intent(in)    :: smoother, solver, global_num
-    end subroutine amg_s_poly_smoother_dmp
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_clone(sm,smout,info)
-      import :: amg_s_poly_smoother_type, psb_spk_, &
-           & amg_s_base_smoother_type, psb_ipk_
-      class(amg_s_poly_smoother_type), intent(inout)               :: sm
-      class(amg_s_base_smoother_type), allocatable, intent(inout) :: smout
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_s_poly_smoother_clone
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_clone_settings(sm,smout,info)
-      import :: amg_s_poly_smoother_type, psb_spk_, &
-           & amg_s_base_smoother_type, psb_ipk_
-      class(amg_s_poly_smoother_type), intent(inout)               :: sm
-      class(amg_s_base_smoother_type), allocatable, intent(inout) :: smout
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_s_poly_smoother_clone_settings
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_clear_data(sm,info)
-      import :: amg_s_poly_smoother_type, psb_spk_, &
-           & amg_s_base_smoother_type, psb_ipk_
-      class(amg_s_poly_smoother_type), intent(inout)               :: sm
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_s_poly_smoother_clear_data
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_descr(sm,info,iout,coarse,prefix)
-      import :: amg_s_poly_smoother_type, psb_ipk_
-      class(amg_s_poly_smoother_type), intent(in) :: sm
-      integer(psb_ipk_), intent(out)               :: info
-      integer(psb_ipk_), intent(in), optional      :: iout
-      logical, intent(in), optional                :: coarse
-      character(len=*), intent(in), optional       :: prefix
-    end subroutine amg_s_poly_smoother_descr
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_cseti(sm,what,val,info,idx)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_s_poly_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      integer(psb_ipk_), intent(in)                  :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_s_poly_smoother_cseti
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_csetc(sm,what,val,info,idx)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_s_poly_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      character(len=*), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_s_poly_smoother_csetc
-  end interface
-
-  interface
-    subroutine amg_s_poly_smoother_csetr(sm,what,val,info,idx)
-      import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
-           & psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_s_poly_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      real(psb_spk_), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_s_poly_smoother_csetr
-  end interface
-
-
-contains
-
-
-  subroutine s_poly_smoother_free(sm,info)
-
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_poly_smoother_type), intent(inout) :: sm
-    integer(psb_ipk_), intent(out)                  :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20)  :: name='s_poly_smoother_free'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-
-
-    if (allocated(sm%sv)) then
-      call sm%sv%free(info)
-      if (info == psb_success_) deallocate(sm%sv,stat=info)
-      if (info /= psb_success_) then
-        info = psb_err_alloc_dealloc_
-        call psb_errpush(info,name)
-        goto 9999
-      end if
-    end if
-    if (allocated(sm%poly_beta))  deallocate(sm%poly_beta)
-    sm%pa => null()
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine s_poly_smoother_free
-
-  function s_poly_smoother_sizeof(sm) result(val)
-
-    implicit none
-    ! Arguments
-    class(amg_s_poly_smoother_type), intent(in) :: sm
-    integer(psb_epk_) :: val
-
-    val = psb_sizeof_dp
-    if (allocated(sm%sv)) val = val + sm%sv%sizeof()
-    if (allocated(sm%poly_beta)) val = val + psb_sizeof_dp * size(sm%poly_beta)
-
-    return
-  end function s_poly_smoother_sizeof
-
-  subroutine s_poly_smoother_default(sm)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_s_poly_smoother_type), intent(inout) :: sm
-
-    !
-    ! Default: BJAC with no residual check
-    !
-    sm%pdegree      = 1
-    sm%rho_ba       = -sone
-    sm%variant      = amg_cheb_4_
-    sm%rho_estimate = amg_poly_rho_est_power_
-    sm%rho_estimate_iterations = 20
-    if (allocated(sm%sv)) then
-      call sm%sv%default()
-    end if
-
-    return
-  end subroutine s_poly_smoother_default
-
-  function s_poly_smoother_get_nzeros(sm) result(val)
-
-    implicit none
-    ! Arguments
-    class(amg_s_poly_smoother_type), intent(in) :: sm
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-
-    val = 0
-    if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()
-
-    return
-  end function s_poly_smoother_get_nzeros
-
-  function s_poly_smoother_get_wrksize(sm) result(val)
-    implicit none
-    class(amg_s_poly_smoother_type), intent(inout) :: sm
-    integer(psb_ipk_)  :: val
-
-    val = 4
-    if (allocated(sm%sv)) val = val + sm%sv%get_wrksz()
-
-  end function s_poly_smoother_get_wrksize
-
-  function s_poly_smoother_get_fmt() result(val)
-    implicit none
-    character(len=32)  :: val
-
-    val = "Polynomial smoother"
-  end function s_poly_smoother_get_fmt
-
-  function s_poly_smoother_get_id() result(val)
-    implicit none
-    integer(psb_ipk_)  :: val
-
-    val = amg_poly_
-  end function s_poly_smoother_get_id
-
-
-end module amg_s_poly_smoother

amgprec/amg_s_prec_type.f90

@@ -135,11 +135,8 @@ module amg_s_prec_type
     procedure, pass(prec)               :: build        => amg_sprecbld
     procedure, pass(prec)               :: hierarchy_build   => amg_s_hierarchy_bld
     procedure, pass(prec)               :: hierarchy_rebuild => amg_s_hierarchy_rebld
-    procedure, pass(prec)               :: hierarchy_free    => amg_s_hierarchy_free    
     procedure, pass(prec)               :: smoothers_build   => amg_s_smoothers_bld
-    procedure, pass(prec)               :: smoothers_free    => amg_s_smoothers_free
     procedure, pass(prec)               :: descr        =>  amg_sfile_prec_descr
-    procedure, pass(prec)               :: memory_use   =>  amg_sfile_prec_memory_use
   end type amg_sprec_type
 
   private :: amg_s_dump, amg_s_get_compl,  amg_s_cmp_compl,&
@@ -171,22 +168,6 @@ module amg_s_prec_type
     end subroutine amg_sfile_prec_descr
   end interface
 
-  
-  interface amg_memory_use
-    subroutine amg_sfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
-      import :: amg_sprec_type, psb_ipk_
-      implicit none
-      ! Arguments
-      class(amg_sprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: root
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_sfile_prec_memory_use
-  end interface
-
   interface amg_sizeof
     module procedure amg_sprec_sizeof
   end interface
@@ -364,14 +345,6 @@ module amg_s_prec_type
     end subroutine amg_s_smoothers_bld
   end interface amg_smoothers_bld
 
-  interface amg_smoothers_free
-    module procedure  amg_s_smoothers_free
-  end interface amg_smoothers_free
-
-  interface amg_hierarchy_free
-    module procedure amg_s_hierarchy_free
-  end interface amg_hierarchy_free
-
 contains
   !
   ! Function returning a pointer to the smoother
@@ -645,68 +618,6 @@ contains
 
   end subroutine amg_s_prec_free
 
-  subroutine amg_s_smoothers_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_sprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_s_smoothers_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
-        call prec%precv(i)%free_smoothers(info)
-      end do
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_s_smoothers_free
-
-  subroutine amg_s_hierarchy_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_sprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_s_hierarchy_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    me=-1
-    write(0,*) 'Missing implementation '
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_s_hierarchy_free
 
 
   !

amgprec/amg_z_ainv_solver.F90

@@ -58,7 +58,6 @@ module amg_z_ainv_solver
     procedure, pass(sv) :: check   => amg_z_ainv_solver_check
     procedure, pass(sv) :: build   => amg_z_ainv_solver_bld
     procedure, pass(sv) :: clone   => amg_z_ainv_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_z_ainv_solver_clone_settings
     procedure, pass(sv) :: cseti   => amg_z_ainv_solver_cseti
     procedure, pass(sv) :: csetc   => amg_z_ainv_solver_csetc
     procedure, pass(sv) :: csetr   => amg_z_ainv_solver_csetr
@@ -86,16 +85,6 @@ module amg_z_ainv_solver
     end subroutine amg_z_ainv_solver_clone
   end interface
 
-  interface
-    subroutine amg_z_ainv_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
-       & amg_z_base_solver_type, psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
-      Implicit None
-      class(amg_z_ainv_solver_type), intent(inout)              :: sv
-      class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_z_ainv_solver_clone_settings
-  end interface
 
   interface
     subroutine amg_z_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)

amgprec/amg_z_ilu_solver.f90

@@ -234,7 +234,7 @@ contains
     ! Arguments
     class(amg_z_ilu_solver_type), intent(inout) :: sv
 
-    sv%fact_type = amg_ilu_n_
+    sv%fact_type = psb_ilu_n_
     sv%fill_in   = 0
     sv%thresh    = dzero
 
@@ -255,13 +255,13 @@ contains
     info = psb_success_
 
     call amg_check_def(sv%fact_type,&
-         & 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
+         & 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
 
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
+    case(psb_ilu_n_,psb_milu_n_)      
       call amg_check_def(sv%fill_in,&
            & 'Level',izero,is_int_non_negative)
-    case(amg_ilu_t_)                 
+    case(psb_ilu_t_)                 
       call amg_check_def(sv%thresh,&
            & 'Eps',dzero,is_legal_d_fact_thrs)
     end select
@@ -439,9 +439,9 @@ contains
     write(iout_,*) trim(prefix_), '  Incomplete factorization solver: ',&
          &  amg_fact_names(sv%fact_type)
     select case(sv%fact_type)
-    case(amg_ilu_n_,amg_milu_n_)      
+    case(psb_ilu_n_,psb_milu_n_)      
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
-    case(amg_ilu_t_)         
+    case(psb_ilu_t_)         
       write(iout_,*) trim(prefix_), '  Fill level:',sv%fill_in
       write(iout_,*) trim(prefix_), '  Fill threshold :',sv%thresh
     end select
@@ -496,7 +496,7 @@ contains
     implicit none 
     integer(psb_ipk_)  :: val
     
-    val = amg_ilu_n_
+    val = psb_ilu_n_
   end function z_ilu_solver_get_id
 
   function z_ilu_solver_get_wrksize() result(val)

amgprec/amg_z_inner_mod.f90

@@ -109,12 +109,11 @@ module amg_z_inner_mod
   end interface amg_map_to_tprol
 
   abstract interface
-    subroutine amg_zaggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
+    subroutine amg_zaggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
          & ac,desc_ac,op_prol,op_restr,t_prol,info)
       import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_, psb_lpk_, psb_lzspmat_type
       import ::  amg_z_onelev_type, amg_dml_parms
       implicit none 
-      integer(psb_ipk_), intent(in)               :: dol1smoothing
       type(psb_zspmat_type), intent(in)         :: a
       type(psb_desc_type), intent(inout)          :: desc_a
       integer(psb_lpk_), intent(inout)            :: ilaggr(:), nlaggr(:)

amgprec/amg_z_invk_solver.f90

@@ -52,7 +52,6 @@ module amg_z_invk_solver
   contains
     procedure, pass(sv) :: check   => amg_z_invk_solver_check
     procedure, pass(sv) :: clone   => amg_z_invk_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_z_invk_solver_clone_settings
     procedure, pass(sv) :: build   => amg_z_invk_solver_bld
     procedure, pass(sv) :: cseti   => amg_z_invk_solver_cseti
     procedure, pass(sv) :: descr   => amg_z_invk_solver_descr
@@ -74,17 +73,6 @@ module amg_z_invk_solver
     end subroutine amg_z_invk_solver_clone
   end interface
 
-  interface
-    subroutine amg_z_invk_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
-       & amg_z_base_solver_type, psb_dpk_, amg_z_invk_solver_type, psb_ipk_
-      Implicit None
-      class(amg_z_invk_solver_type), intent(inout)              :: sv
-      class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_z_invk_solver_clone_settings
-  end interface
-
   interface
     subroutine amg_z_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &

amgprec/amg_z_invt_solver.f90

@@ -52,7 +52,6 @@ module amg_z_invt_solver
   contains
     procedure, pass(sv) :: check   => amg_z_invt_solver_check
     procedure, pass(sv) :: clone   => amg_z_invt_solver_clone
-    procedure, pass(sv) :: clone_settings   => amg_z_invt_solver_clone_settings
     procedure, pass(sv) :: build   => amg_z_invt_solver_bld
     procedure, pass(sv) :: cseti   => amg_z_invt_solver_cseti
     procedure, pass(sv) :: csetr   => amg_z_invt_solver_csetr
@@ -74,17 +73,6 @@ module amg_z_invt_solver
     end subroutine amg_z_invt_solver_clone
   end interface
 
-  interface
-    subroutine amg_z_invt_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
-       & amg_z_base_solver_type, psb_dpk_, amg_z_invt_solver_type, psb_ipk_
-      Implicit None
-      class(amg_z_invt_solver_type), intent(inout)              :: sv
-      class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)                            :: info
-    end subroutine amg_z_invt_solver_clone_settings
-  end interface
-
   interface
     subroutine amg_z_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &

amgprec/amg_z_jac_solver.f90

@@ -1,585 +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 written permission.
-!   
-!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
-!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-!    POSSIBILITY OF SUCH DAMAGE.
-!   
-!  
-!
-!
-! File: amg_z_jac_solver_mod.f90
-!
-! Module: amg_z_jac_solver_mod
-!
-!  This module defines: 
-!  - the amg_z_jac_solver_type data structure containing the ingredients
-!    for a local Jacobi  iteration. The iterations are local to a process
-!    (they operate on the block diagonal).
-!    
-!
-module amg_z_jac_solver
-
-  use amg_z_base_solver_mod
-
-  type, extends(amg_z_base_solver_type) :: amg_z_jac_solver_type
-    type(psb_zspmat_type)      :: a
-    type(psb_z_vect_type), allocatable :: dv
-    complex(psb_dpk_), allocatable        :: d(:)
-    integer(psb_ipk_)          :: sweeps
-    real(psb_dpk_)             :: eps
-  contains
-    procedure, pass(sv) :: dump    => amg_z_jac_solver_dmp
-    procedure, pass(sv) :: check   => z_jac_solver_check
-    procedure, pass(sv) :: clone   => amg_z_jac_solver_clone
-    procedure, pass(sv) :: clone_settings => amg_z_jac_solver_clone_settings
-    procedure, pass(sv) :: clear_data     => amg_z_jac_solver_clear_data
-    procedure, pass(sv) :: build   => amg_z_jac_solver_bld
-    procedure, pass(sv) :: cnv     => amg_z_jac_solver_cnv
-    procedure, pass(sv) :: apply_v => amg_z_jac_solver_apply_vect
-    procedure, pass(sv) :: apply_a => amg_z_jac_solver_apply
-    procedure, pass(sv) :: free    => z_jac_solver_free
-    procedure, pass(sv) :: cseti   => z_jac_solver_cseti
-    procedure, pass(sv) :: csetc   => z_jac_solver_csetc
-    procedure, pass(sv) :: csetr   => z_jac_solver_csetr
-    procedure, pass(sv) :: descr   => z_jac_solver_descr
-    procedure, pass(sv) :: default => z_jac_solver_default
-    procedure, pass(sv) :: sizeof  => z_jac_solver_sizeof
-    procedure, pass(sv) :: get_nzeros => z_jac_solver_get_nzeros
-    procedure, nopass   :: get_wrksz  => z_jac_solver_get_wrksize
-    procedure, nopass   :: get_fmt    => z_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => z_jac_solver_get_id
-    procedure, nopass   :: is_iterative => z_jac_solver_is_iterative
-  end type amg_z_jac_solver_type
-
-  type, extends(amg_z_jac_solver_type) :: amg_z_l1_jac_solver_type
-  contains
-    procedure, pass(sv) :: build   => amg_z_l1_jac_solver_bld
-    procedure, pass(sv) :: descr   => z_l1_jac_solver_descr
-    procedure, nopass   :: get_fmt    => z_l1_jac_solver_get_fmt
-    procedure, nopass   :: get_id     => z_l1_jac_solver_get_id
-  end type amg_z_l1_jac_solver_type
-
-
-  private :: z_jac_solver_bld, z_jac_solver_apply, &
-       &  z_jac_solver_free,   &
-       &  z_jac_solver_descr,  z_jac_solver_sizeof, &
-       &  z_jac_solver_default, z_jac_solver_dmp, &
-       &  z_jac_solver_apply_vect, z_jac_solver_get_nzeros, &
-       &  z_jac_solver_get_fmt, z_jac_solver_check,&
-       &  z_jac_solver_is_iterative, &
-       &  z_jac_solver_get_id, z_jac_solver_get_wrksize
-
-  interface 
-    subroutine amg_z_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
-         & trans,work,wv,info,init,initu)
-      import :: psb_desc_type, amg_z_jac_solver_type, psb_z_vect_type, psb_dpk_, &
-           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)             :: desc_data
-      class(amg_z_jac_solver_type), intent(inout) :: sv
-      type(psb_z_vect_type),intent(inout)         :: x
-      type(psb_z_vect_type),intent(inout)         :: y
-      complex(psb_dpk_),intent(in)                    :: alpha,beta
-      character(len=1),intent(in)                   :: trans
-      complex(psb_dpk_),target, intent(inout)         :: work(:)
-      type(psb_z_vect_type),intent(inout)         :: wv(:)
-      integer(psb_ipk_), intent(out)                :: info
-      character, intent(in), optional                :: init
-      type(psb_z_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_z_jac_solver_apply_vect
-  end interface
-
-  interface 
-    subroutine amg_z_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
-      import :: psb_desc_type, amg_z_jac_solver_type, psb_z_vect_type, psb_dpk_, &
-           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
-      implicit none 
-      type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_z_jac_solver_type), intent(inout) :: sv
-      complex(psb_dpk_),intent(inout)         :: x(:)
-      complex(psb_dpk_),intent(inout)         :: y(:)
-      complex(psb_dpk_),intent(in)            :: alpha,beta
-      character(len=1),intent(in)           :: trans
-      complex(psb_dpk_),target, intent(inout) :: work(:)
-      integer(psb_ipk_), intent(out)        :: info
-      character, intent(in), optional       :: init
-      complex(psb_dpk_),intent(inout), optional :: initu(:)
-    end subroutine amg_z_jac_solver_apply
-  end interface
-
-  interface 
-    subroutine amg_z_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_z_jac_solver_type, psb_z_vect_type, psb_dpk_, &
-           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_zspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_z_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_zspmat_type), intent(in), target, optional :: b
-      class(psb_z_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_z_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional   :: imold
-    end subroutine amg_z_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_z_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
-      import :: psb_desc_type, amg_z_l1_jac_solver_type, psb_z_vect_type, psb_dpk_, &
-           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      type(psb_zspmat_type), intent(in), target           :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a 
-      class(amg_z_l1_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      type(psb_zspmat_type), intent(in), target, optional :: b
-      class(psb_z_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_z_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional   :: imold
-    end subroutine amg_z_l1_jac_solver_bld
-  end interface
-
-  interface 
-    subroutine amg_z_jac_solver_cnv(sv,info,amold,vmold,imold)
-      import :: amg_z_jac_solver_type, psb_dpk_, &
-           & psb_z_base_sparse_mat, psb_z_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      implicit none 
-      class(amg_z_jac_solver_type), intent(inout)         :: sv
-      integer(psb_ipk_), intent(out)                      :: info
-      class(psb_z_base_sparse_mat), intent(in), optional  :: amold
-      class(psb_z_base_vect_type), intent(in), optional   :: vmold
-      class(psb_i_base_vect_type), intent(in), optional   :: imold
-    end subroutine amg_z_jac_solver_cnv
-  end interface
-  
-  interface 
-    subroutine amg_z_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
-      import :: psb_desc_type, amg_z_jac_solver_type, psb_z_vect_type, psb_dpk_, &
-           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, &
-           & psb_ipk_
-      implicit none 
-      class(amg_z_jac_solver_type), intent(in) :: sv
-      type(psb_desc_type), intent(in)             :: desc
-      integer(psb_ipk_), intent(in)              :: level
-      integer(psb_ipk_), intent(out)             :: info
-      character(len=*), intent(in), optional     :: prefix, head
-      logical, optional, intent(in)              :: solver, global_num
-    end subroutine amg_z_jac_solver_dmp
-  end interface
-  
-  interface
-    subroutine amg_z_jac_solver_clone(sv,svout,info)
-      import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
-           & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
-           & amg_z_base_solver_type, amg_z_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_z_jac_solver_type), intent(inout)               :: sv
-      class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
-      integer(psb_ipk_), intent(out)              :: info
-    end subroutine amg_z_jac_solver_clone
-  end interface
-  
-!!$  interface
-!!$    subroutine amg_z_l1_jac_solver_clone(sv,svout,info)
-!!$      import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
-!!$           & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
-!!$           & amg_z_base_solver_type, amg_z_l1_jac_solver_type, psb_ipk_
-!!$      Implicit None
-!!$      
-!!$      ! Arguments
-!!$      class(amg_z_l1_jac_solver_type), intent(inout)               :: sv
-!!$      class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
-!!$      integer(psb_ipk_), intent(out)              :: info
-!!$    end subroutine amg_z_l1_jac_solver_clone
-!!$  end interface
-
-  interface
-    subroutine amg_z_jac_solver_clone_settings(sv,svout,info)
-      import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
-           & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
-           & amg_z_base_solver_type, amg_z_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_z_jac_solver_type), intent(inout) :: sv
-      class(amg_z_base_solver_type), intent(inout) :: svout
-      integer(psb_ipk_), intent(out)               :: info
-    end subroutine amg_z_jac_solver_clone_settings
-  end interface
-
-  interface
-    subroutine amg_z_jac_solver_clear_data(sv,info)
-      import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
-           & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
-           & amg_z_jac_solver_type, psb_ipk_
-      Implicit None
-      
-      ! Arguments
-      class(amg_z_jac_solver_type), intent(inout) :: sv
-      integer(psb_ipk_), intent(out)                 :: info
-    end subroutine amg_z_jac_solver_clear_data
-  end interface
-
-contains
-
-  subroutine z_jac_solver_default(sv)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_z_jac_solver_type), intent(inout) :: sv
-
-    sv%sweeps = ione
-    sv%eps    = dzero
-    
-    return
-  end subroutine z_jac_solver_default
-
-  subroutine z_jac_solver_check(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_z_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20) :: name='z_jac_solver_check'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call amg_check_def(sv%sweeps,&
-         & 'Jacobi sweeps',ione,is_int_positive)
-
-    if (info /= psb_success_) goto 9999
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine z_jac_solver_check
-
-  subroutine z_jac_solver_cseti(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_z_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    integer(psb_ipk_), intent(in)                 :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='z_jac_solver_cseti'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-    select case(psb_toupper(what))
-    case('SOLVER_SWEEPS')
-      sv%sweeps = val      
-    case default
-      call sv%amg_z_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine z_jac_solver_cseti
-
-  subroutine z_jac_solver_csetc(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_z_jac_solver_type), intent(inout) :: sv
-    character(len=*), intent(in)                  :: what 
-    character(len=*), intent(in)                  :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act, ival
-    character(len=20)  :: name='z_jac_solver_csetc'
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-
-    call sv%amg_z_base_solver_type%set(what,val,info,idx=idx)
-  
-    if (info /= psb_success_) then
-      info = psb_err_from_subroutine_
-      call psb_errpush(info, name)
-      goto 9999
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine z_jac_solver_csetc
-  
-  subroutine z_jac_solver_csetr(sv,what,val,info,idx)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_z_jac_solver_type), intent(inout) :: sv 
-    character(len=*), intent(in)                  :: what 
-    real(psb_dpk_), intent(in)                     :: val
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_), intent(in), optional       :: idx
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='z_jac_solver_csetr'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    select case(psb_toupper(what))
-    case('SOLVER_EPS') 
-      sv%eps = val
-    case default
-      call sv%amg_z_base_solver_type%set(what,val,info,idx=idx)
-    end select
-
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine z_jac_solver_csetr
-
-  subroutine z_jac_solver_free(sv,info)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_z_jac_solver_type), intent(inout) :: sv
-    integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_)  :: err_act
-    character(len=20)  :: name='z_jac_solver_free'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    call sv%a%free()
-    if (allocated(sv%dv)) then
-      call sv%dv%free(info)
-      deallocate(sv%dv)
-    end if
-    if (allocated(sv%d)) deallocate(sv%d)
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine z_jac_solver_free
-
-  subroutine z_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_z_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_z_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine z_jac_solver_descr
-
-  function z_jac_solver_get_nzeros(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_z_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-    
-    val = 0 
-    val = val + sv%a%get_nzeros()
-    val = val + sv%dv%get_nrows()
-
-    return
-  end function z_jac_solver_get_nzeros
-
-  function z_jac_solver_sizeof(sv) result(val)
-
-    implicit none 
-    ! Arguments
-    class(amg_z_jac_solver_type), intent(in) :: sv
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-
-    val = psb_sizeof_ip 
-    val = val + sv%a%sizeof()
-    val = val + sv%dv%sizeof()
-
-    return
-  end function z_jac_solver_sizeof
-
-  function z_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "Jacobi solver"
-  end function z_jac_solver_get_fmt
-
-  function z_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_jac_
-  end function z_jac_solver_get_id
-
-  !
-  ! If this is true, then the solver needs a starting
-  ! guess. Currently only handled in JAC smoother. 
-  ! 
-  function z_jac_solver_is_iterative() result(val)
-    implicit none 
-    logical  :: val
-
-    val = .true.
-  end function z_jac_solver_is_iterative
-    
-  function z_jac_solver_get_wrksize() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = 2
-  end function z_jac_solver_get_wrksize
-
-  subroutine z_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
-
-    Implicit None
-
-    ! Arguments
-    class(amg_z_l1_jac_solver_type), intent(in) :: sv
-    integer(psb_ipk_), intent(out)            :: info
-    integer(psb_ipk_), intent(in), optional   :: iout
-    logical, intent(in), optional             :: coarse
-    character(len=*), intent(in), optional    :: prefix
-
-    ! Local variables
-    integer(psb_ipk_)      :: err_act
-    character(len=20), parameter :: name='amg_z_l1_jac_solver_descr'
-    integer(psb_ipk_) :: iout_
-    character(1024)    :: prefix_
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-    if (present(iout)) then 
-      iout_ = iout 
-    else
-      iout_ = psb_out_unit
-    endif
-    if (present(prefix)) then
-      prefix_ = prefix
-    else
-      prefix_ = ""
-    end if
-
-    if (sv%eps<=dzero) then 
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  ',&
-           &  sv%sweeps,' sweeps'
-    else
-      write(iout_,*) trim(prefix_), '  L1-Jacobi iterative solver with  tolerance',&
-           &  sv%eps,' and maxit', sv%sweeps
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine z_l1_jac_solver_descr
-
-  function z_l1_jac_solver_get_fmt() result(val)
-    implicit none 
-    character(len=32)  :: val
-
-    val = "L1-Jacobi solver"
-  end function z_l1_jac_solver_get_fmt
-
-  function z_l1_jac_solver_get_id() result(val)
-    implicit none 
-    integer(psb_ipk_)  :: val
-
-    val = amg_l1_jac_
-  end function z_l1_jac_solver_get_id
-  
-end module amg_z_jac_solver

amgprec/amg_z_mumps_solver.F90

@@ -78,8 +78,7 @@ module amg_z_mumps_solver
     !
     ! Controls to be set before MUMPS instantiation:
     !
-    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: 'LOCAL_SOLVER
-    !                            1==amg_global_solver_: 'GLOBAL_SOLVER'
+    ! IPAR(1) : MUMPS_LOC_GLOB   0==amg_local_solver_: LOCAL   1==amg_global_solver_: GLOBAL
     ! IPAR(2) : MUMPS_PRINT_ERR  print verbosity (see MUMPS)
     ! IPAR(3) : MUMPS_SYM        0: non-symmetric   2: symmetric
     integer(psb_ipk_), dimension(3) :: ipar

amgprec/amg_z_onelev_mod.f90

@@ -187,10 +187,8 @@ module amg_z_onelev_mod
     procedure, pass(lv) :: clone   => z_base_onelev_clone
     procedure, pass(lv) :: cnv     => amg_z_base_onelev_cnv
     procedure, pass(lv) :: descr   => amg_z_base_onelev_descr
-    procedure, pass(lv) :: memory_use  => amg_z_base_onelev_memory_use
     procedure, pass(lv) :: default => z_base_onelev_default
     procedure, pass(lv) :: free    => amg_z_base_onelev_free
-    procedure, pass(lv) :: free_smoothers => amg_z_base_onelev_free_smoothers
     procedure, pass(lv) :: nullify => z_base_onelev_nullify
     procedure, pass(lv) :: check => amg_z_base_onelev_check
     procedure, pass(lv) :: dump  => amg_z_base_onelev_dump
@@ -274,23 +272,6 @@ module amg_z_onelev_mod
     end subroutine amg_z_base_onelev_descr
   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
-      Implicit None
-      ! Arguments
-      class(amg_z_onelev_type), intent(in)    :: lv
-      integer(psb_ipk_), intent(in)           :: il,nl,ilmin
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_z_base_onelev_memory_use
-  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_, &
@@ -304,7 +285,7 @@ module amg_z_onelev_mod
     end subroutine amg_z_base_onelev_cnv
   end interface
 
-  interface
+interface
     subroutine amg_z_base_onelev_free(lv,info)
       import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
            & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
@@ -316,18 +297,6 @@ module amg_z_onelev_mod
     end subroutine amg_z_base_onelev_free
   end interface
 
-  interface
-    subroutine amg_z_base_onelev_free_smoothers(lv,info)
-      import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
-           & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
-           & psb_ipk_, psb_epk_, psb_desc_type
-      implicit none
-
-      class(amg_z_onelev_type), intent(inout) :: lv
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_z_base_onelev_free_smoothers
-  end interface
-
   interface
     subroutine amg_z_base_onelev_check(lv,info)
       import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &

amgprec/amg_z_prec_type.f90

@@ -135,11 +135,8 @@ module amg_z_prec_type
     procedure, pass(prec)               :: build        => amg_zprecbld
     procedure, pass(prec)               :: hierarchy_build   => amg_z_hierarchy_bld
     procedure, pass(prec)               :: hierarchy_rebuild => amg_z_hierarchy_rebld
-    procedure, pass(prec)               :: hierarchy_free    => amg_z_hierarchy_free    
     procedure, pass(prec)               :: smoothers_build   => amg_z_smoothers_bld
-    procedure, pass(prec)               :: smoothers_free    => amg_z_smoothers_free
     procedure, pass(prec)               :: descr        =>  amg_zfile_prec_descr
-    procedure, pass(prec)               :: memory_use   =>  amg_zfile_prec_memory_use
   end type amg_zprec_type
 
   private :: amg_z_dump, amg_z_get_compl,  amg_z_cmp_compl,&
@@ -171,22 +168,6 @@ module amg_z_prec_type
     end subroutine amg_zfile_prec_descr
   end interface
 
-  
-  interface amg_memory_use
-    subroutine amg_zfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
-      import :: amg_zprec_type, psb_ipk_
-      implicit none
-      ! Arguments
-      class(amg_zprec_type), intent(in)     :: prec
-      integer(psb_ipk_), intent(out)          :: info
-      integer(psb_ipk_), intent(in), optional :: iout
-      integer(psb_ipk_), intent(in), optional :: root
-      integer(psb_ipk_), intent(in), optional :: verbosity
-      character(len=*), intent(in), optional  :: prefix
-      logical, intent(in), optional           :: global
-    end subroutine amg_zfile_prec_memory_use
-  end interface
-
   interface amg_sizeof
     module procedure amg_zprec_sizeof
   end interface
@@ -364,14 +345,6 @@ module amg_z_prec_type
     end subroutine amg_z_smoothers_bld
   end interface amg_smoothers_bld
 
-  interface amg_smoothers_free
-    module procedure  amg_z_smoothers_free
-  end interface amg_smoothers_free
-
-  interface amg_hierarchy_free
-    module procedure amg_z_hierarchy_free
-  end interface amg_hierarchy_free
-
 contains
   !
   ! Function returning a pointer to the smoother
@@ -645,68 +618,6 @@ contains
 
   end subroutine amg_z_prec_free
 
-  subroutine amg_z_smoothers_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_zprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_z_smoothers_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    if (allocated(prec%precv)) then
-      do i=1,size(prec%precv)
-        call prec%precv(i)%free_smoothers(info)
-      end do
-    end if
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_z_smoothers_free
-
-  subroutine amg_z_hierarchy_free(prec,info)
-
-    implicit none
-
-    ! Arguments
-    class(amg_zprec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(out)        :: info
-
-    ! Local variables
-    integer(psb_ipk_)   :: me,err_act,i
-    character(len=20)   :: name
-
-    info=psb_success_
-    name = 'amg_z_hierarchy_free'
-    call psb_erractionsave(err_act)
-    if (psb_errstatus_fatal()) then
-      info = psb_err_internal_error_; goto 9999
-    end if
-
-    me=-1
-    write(0,*) 'Missing implementation '
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-
-  end subroutine amg_z_hierarchy_free
 
 
   !

amgprec/impl/Makefile

@@ -22,22 +22,22 @@ MPFOBJS=$(SMPFOBJS) $(DMPFOBJS) $(CMPFOBJS) $(ZMPFOBJS)
 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 \
+DINNEROBJS= amg_dmlprec_bld.o amg_dfile_prec_descr.o \
 	amg_d_smoothers_bld.o amg_d_hierarchy_bld.o amg_d_hierarchy_rebld.o \
 	amg_dmlprec_aply.o   \
 	$(DMPFOBJS) amg_d_extprol_bld.o
 
-SINNEROBJS=   amg_smlprec_bld.o amg_sfile_prec_descr.o amg_sfile_prec_memory_use.o \
+SINNEROBJS=   amg_smlprec_bld.o amg_sfile_prec_descr.o \
 	amg_s_smoothers_bld.o amg_s_hierarchy_bld.o amg_s_hierarchy_rebld.o \
 	amg_smlprec_aply.o   \
 	$(SMPFOBJS) amg_s_extprol_bld.o 
 
-ZINNEROBJS=   amg_zmlprec_bld.o amg_zfile_prec_descr.o amg_zfile_prec_memory_use.o \
+ZINNEROBJS=   amg_zmlprec_bld.o amg_zfile_prec_descr.o \
 	amg_z_smoothers_bld.o amg_z_hierarchy_bld.o amg_z_hierarchy_rebld.o \
 	amg_zmlprec_aply.o   \
 	$(ZMPFOBJS)  amg_z_extprol_bld.o
 
-CINNEROBJS=   amg_cmlprec_bld.o amg_cfile_prec_descr.o amg_cfile_prec_memory_use.o \
+CINNEROBJS=   amg_cmlprec_bld.o amg_cfile_prec_descr.o \
 	amg_c_smoothers_bld.o amg_c_hierarchy_bld.o amg_c_hierarchy_rebld.o \
 	amg_cmlprec_aply.o   \
 	$(CMPFOBJS)  amg_c_extprol_bld.o

amgprec/impl/aggregator/Makefile

@@ -5,7 +5,7 @@ MODDIR=../../../modules
 HERE=../..
 
 FINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR) $(PSBLAS_INCLUDES)
-CXXINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(INCDIR) $(FMFLAG)/.
+CXXINCLUDES=$(FIFLAG)$(HERE) $(FIFLAG)$(INCDIR) $(FIFLAG)/. -I../../../../ParallelRomaF-main/include -I$(PSBLAS_INCDIR)
 
 #CINCLUDES= -I${SUPERLU_INCDIR} -I${HSL_INCDIR}  -I${SPRAL_INCDIR} -I/home/users/pasqua/Ambra/BootCMatch/include -lBCM -L/home/users/pasqua/Ambra/BootCMatch/lib  -lm
 
@@ -59,9 +59,18 @@ amg_s_parmatch_spmm_bld.o \
 amg_s_parmatch_spmm_bld_ov.o \
 amg_s_parmatch_unsmth_bld.o \
 amg_s_parmatch_smth_bld.o \
-amg_s_parmatch_spmm_bld_inner.o
+amg_s_parmatch_spmm_bld_inner.o \
+amg_d_newmatch_aggregator_inner_mat_asb.o\
+amg_d_newmatch_aggregator_mat_asb.o \
+amg_d_newmatch_aggregator_mat_bld.o \
+amg_d_newmatch_aggregator_tprol.o  \
+amg_d_newmatch_map_to_tprol.o \
+amg_d_newmatch_spmm_bld_inner.o \
+amg_d_newmatch_spmm_bld_ov.o
 
-MPCOBJS=MatchBoxPC.o \
+MPCXXOBJS=MatchBoxPC.o \
+algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o \
+newmatch_interface.o \
 sendBundledMessages.o \
 initialize.o \
 extractUChunk.o \
@@ -76,10 +85,10 @@ processCrossEdge.o \
 queueTransfer.o \
 processMessages.o \
 processExposedVertex.o \
-algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o \
-algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.o
+algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.o \
+MatchingAlgorithms.o
 
-OBJS = $(FOBJS) $(MPCOBJS)
+OBJS = $(FOBJS) $(MPCOBJS) $(MPCXXOBJS) 
 
 LIBNAME=libamg_prec.a
 
@@ -89,10 +98,6 @@ lib:  objs
 	$(AR) $(HERE)/$(LIBNAME) $(OBJS)
 	$(RANLIB) $(HERE)/$(LIBNAME)
 
-mpobjs:
-	(make $(MPFOBJS) F90="$(MPF90)" F90COPT="$(F90COPT)")
-	(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
-
 veryclean: clean
 	/bin/rm -f $(LIBNAME)
 

amgprec/impl/aggregator/MatchBoxPC.cpp

@@ -67,13 +67,13 @@ void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
 #endif
 
 
-#undef TIME_TRACKER
-#ifdef TIME_TRACKER
-  double tmr = MPI_Wtime();
-#endif
+#define TIME_TRACKER
+    #ifdef TIME_TRACKER
+        double tmr = MPI_Wtime();
+    #endif
 
-#if defined(OPENMP)
-	//fprintf(stderr,"Warning: using buggy OpenMP matching!\n");
+#define OMP
+#ifdef OMP
         dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(NLVer, NLEdge,
 							   verLocPtr, verLocInd, edgeLocWeight,
 							   verDistance,  Mate,
@@ -92,11 +92,11 @@ void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
 #endif
 
 
-#ifdef TIME_TRACKER
-	tmr = MPI_Wtime() - tmr;
-	fprintf(stderr, "Elaboration time: %f for %ld nodes\n", tmr, NLVer);
-#endif
-	
+  #ifdef TIME_TRACKER
+    tmr = MPI_Wtime() - tmr;
+    fprintf(stderr, "Elaboration time: %f for %ld nodes\n", tmr, NLVer);
+  #endif
+
 #endif
 }
 
@@ -114,24 +114,13 @@ void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
   fprintf(stderr,"MatchBoxPC: rank %d nlver %ld nledge %ld [ %ld %ld ]\n",
 	  myRank,NLVer, NLEdge,verDistance[0],verDistance[1]);
 #endif
-#if defined(OPENMP)
-	//fprintf(stderr,"Warning: using buggy OpenMP matching!\n");
-  salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(NLVer, NLEdge,
-							      verLocPtr, verLocInd, edgeLocWeight,
-							      verDistance,  Mate,
-							      myRank, numProcs, C_comm,
-							      msgIndSent, msgActualSent, msgPercent,
-							      ph0_time, ph1_time, ph2_time,
-							      ph1_card, ph2_card );
-#else
   salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(NLVer, NLEdge,
-							    verLocPtr, verLocInd, edgeLocWeight,
-							    verDistance,  Mate,
-							    myRank, numProcs, C_comm,
-							    msgIndSent, msgActualSent, msgPercent,
-							    ph0_time, ph1_time, ph2_time,
-							    ph1_card, ph2_card );
-#endif
+							   verLocPtr, verLocInd, edgeLocWeight,
+							   verDistance,  Mate,
+							   myRank, numProcs, C_comm,
+							   msgIndSent, msgActualSent, msgPercent,
+							   ph0_time, ph1_time, ph2_time,
+							   ph1_card, ph2_card );
 #endif
 }
 

amgprec/impl/aggregator/MatchBoxPC.h

@@ -59,11 +59,7 @@
 #include <assert.h>
 #include <map>
 #include <vector>
-#ifdef OPENMP
-// OpenMP is included and used if and only if the OpenMP version of the matching
-// is required
 #include "omp.h"
-#endif
 #include "primitiveDataTypeDefinitions.h"
 #include "dataStrStaticQueue.h"
 
@@ -82,8 +78,6 @@ const int BundleTag = 9;  // Predefined tag
 
 static vector<MilanLongInt> DEFAULT_VECTOR;
 
-#if !defined(SERIAL_MPI)
-
 // MPI type map
 template <typename T>
 MPI_Datatype TypeMap();
@@ -95,7 +89,6 @@ template <>
 inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
 template <>
 inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
-#endif
 
 #ifdef __cplusplus
 extern "C"
@@ -181,416 +174,252 @@ extern "C"
 #define MilanRealMin MINUS_INFINITY
 #endif
 
-/* These functions are only used in the experimental OMP implementation, if that
-is disabled there is no reason to actually compile or reference them. */
+    // Function of find the owner of a ghost vertex using binary search:
+    MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
+                              MilanInt myRank, MilanInt numProcs);
 
-  // Function of find the owner of a ghost vertex using binary search:
-  MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
-			    MilanInt myRank, MilanInt numProcs);
-  
-  MilanLongInt firstComputeCandidateMateD(MilanLongInt adj1,
-					 MilanLongInt adj2,
-					 MilanLongInt *verLocInd,
-					 MilanReal *edgeLocWeight);
+    MilanLongInt firstComputeCandidateMate(MilanLongInt adj1,
+                                           MilanLongInt adj2,
+                                           MilanLongInt *verLocInd,
+                                           MilanReal *edgeLocWeight);
 
-  
-  void queuesTransfer(vector<MilanLongInt> &U,
-		      vector<MilanLongInt> &privateU,
-		      vector<MilanLongInt> &QLocalVtx,
-		      vector<MilanLongInt> &QGhostVtx,
-		      vector<MilanLongInt> &QMsgType,
-		      vector<MilanInt> &QOwner,
-		      vector<MilanLongInt> &privateQLocalVtx,
-		      vector<MilanLongInt> &privateQGhostVtx,
-		      vector<MilanLongInt> &privateQMsgType,
-		      vector<MilanInt> &privateQOwner);
-  
-  bool isAlreadyMatched(MilanLongInt node,
-			MilanLongInt StartIndex,
-			MilanLongInt EndIndex,
-			vector<MilanLongInt> &GMate,
-			MilanLongInt *Mate,
-			map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
-  
-  MilanLongInt computeCandidateMateD(MilanLongInt adj1,
-				    MilanLongInt adj2,
-				    MilanReal *edgeLocWeight,
-				    MilanLongInt k,
-				    MilanLongInt *verLocInd,
-				    MilanLongInt StartIndex,
-				    MilanLongInt EndIndex,
-				    vector<MilanLongInt> &GMate,
-				    MilanLongInt *Mate,
-				    map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
-  
-  void initialize(MilanLongInt NLVer, MilanLongInt NLEdge,
-		  MilanLongInt StartIndex, MilanLongInt EndIndex,
-		  MilanLongInt *numGhostEdgesPtr,
-		  MilanLongInt *numGhostVerticesPtr,
-		  MilanLongInt *S,
-		  MilanLongInt *verLocInd,
-		  MilanLongInt *verLocPtr,
-		  map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-		  vector<MilanLongInt> &Counter,
-		  vector<MilanLongInt> &verGhostPtr,
-		  vector<MilanLongInt> &verGhostInd,
-		  vector<MilanLongInt> &tempCounter,
-		  vector<MilanLongInt> &GMate,
-		  vector<MilanLongInt> &Message,
-		  vector<MilanLongInt> &QLocalVtx,
-		  vector<MilanLongInt> &QGhostVtx,
-		  vector<MilanLongInt> &QMsgType,
-		  vector<MilanInt> &QOwner,
-		  MilanLongInt *&candidateMate,
-		  vector<MilanLongInt> &U,
-		  vector<MilanLongInt> &privateU,
-		  vector<MilanLongInt> &privateQLocalVtx,
-		  vector<MilanLongInt> &privateQGhostVtx,
-		  vector<MilanLongInt> &privateQMsgType,
-		  vector<MilanInt> &privateQOwner);
-  
-  void clean(MilanLongInt NLVer,
-	     MilanInt myRank,
-	     MilanLongInt MessageIndex,
-	     vector<MPI_Request> &SRequest,
-	     vector<MPI_Status> &SStatus,
-	     MilanInt BufferSize,
-	     MilanLongInt *Buffer,
-	     MilanLongInt msgActual,
-	     MilanLongInt *msgActualSent,
-	     MilanLongInt msgInd,
-	     MilanLongInt *msgIndSent,
-	     MilanLongInt NumMessagesBundled,
-	     MilanReal *msgPercent);
-  
-  void PARALLEL_COMPUTE_CANDIDATE_MATE_BD(MilanLongInt NLVer,
-					 MilanLongInt *verLocPtr,
-					 MilanLongInt *verLocInd,
-					 MilanInt myRank,
-					 MilanReal *edgeLocWeight,
-					 MilanLongInt *candidateMate);
-  
-  void PARALLEL_PROCESS_EXPOSED_VERTEX_BD(MilanLongInt NLVer,
-					 MilanLongInt *candidateMate,
-					 MilanLongInt *verLocInd,
-					 MilanLongInt *verLocPtr,
-					 MilanLongInt StartIndex,
-					 MilanLongInt EndIndex,
-					 MilanLongInt *Mate,
-					 vector<MilanLongInt> &GMate,
-					 map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-					 MilanReal *edgeLocWeight,
-					 MilanLongInt *myCardPtr,
-					 MilanLongInt *msgIndPtr,
-					 MilanLongInt *NumMessagesBundledPtr,
-					 MilanLongInt *SPtr,
-					 MilanLongInt *verDistance,
-					 MilanLongInt *PCounter,
-					 vector<MilanLongInt> &Counter,
-					 MilanInt myRank,
-					 MilanInt numProcs,
-					 vector<MilanLongInt> &U,
-					 vector<MilanLongInt> &privateU,
-					 vector<MilanLongInt> &QLocalVtx,
-					 vector<MilanLongInt> &QGhostVtx,
-					 vector<MilanLongInt> &QMsgType,
-					 vector<MilanInt> &QOwner,
-					 vector<MilanLongInt> &privateQLocalVtx,
-					 vector<MilanLongInt> &privateQGhostVtx,
-					 vector<MilanLongInt> &privateQMsgType,
-					 vector<MilanInt> &privateQOwner);
-  
-  void PROCESS_CROSS_EDGE(MilanLongInt *edge,
-			  MilanLongInt *SPtr);
-  
-  void processMatchedVerticesD(
-			      MilanLongInt NLVer,
-			      vector<MilanLongInt> &UChunkBeingProcessed,
-			      vector<MilanLongInt> &U,
-			      vector<MilanLongInt> &privateU,
-			      MilanLongInt StartIndex,
-			      MilanLongInt EndIndex,
-			      MilanLongInt *myCardPtr,
-			      MilanLongInt *msgIndPtr,
-			      MilanLongInt *NumMessagesBundledPtr,
-			      MilanLongInt *SPtr,
-			      MilanLongInt *verLocPtr,
-			      MilanLongInt *verLocInd,
-			      MilanLongInt *verDistance,
-			      MilanLongInt *PCounter,
-			      vector<MilanLongInt> &Counter,
-			      MilanInt myRank,
-			      MilanInt numProcs,
-			      MilanLongInt *candidateMate,
-			      vector<MilanLongInt> &GMate,
-			      MilanLongInt *Mate,
-			      map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-			      MilanReal *edgeLocWeight,
-			      vector<MilanLongInt> &QLocalVtx,
-			      vector<MilanLongInt> &QGhostVtx,
-			      vector<MilanLongInt> &QMsgType,
-			      vector<MilanInt> &QOwner,
-			      vector<MilanLongInt> &privateQLocalVtx,
-			      vector<MilanLongInt> &privateQGhostVtx,
-			      vector<MilanLongInt> &privateQMsgType,
-			      vector<MilanInt> &privateQOwner);
-  
-  void processMatchedVerticesAndSendMessagesD(
-					     MilanLongInt NLVer,
-					     vector<MilanLongInt> &UChunkBeingProcessed,
-					     vector<MilanLongInt> &U,
-					     vector<MilanLongInt> &privateU,
-					     MilanLongInt StartIndex,
-					     MilanLongInt EndIndex,
-					     MilanLongInt *myCardPtr,
-					     MilanLongInt *msgIndPtr,
-					     MilanLongInt *NumMessagesBundledPtr,
-					     MilanLongInt *SPtr,
-					     MilanLongInt *verLocPtr,
-					     MilanLongInt *verLocInd,
-					     MilanLongInt *verDistance,
-					     MilanLongInt *PCounter,
-					     vector<MilanLongInt> &Counter,
-					     MilanInt myRank,
-					     MilanInt numProcs,
-					     MilanLongInt *candidateMate,
-					     vector<MilanLongInt> &GMate,
-					     MilanLongInt *Mate,
-					     map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-					     MilanReal *edgeLocWeight,
-					     vector<MilanLongInt> &QLocalVtx,
-					     vector<MilanLongInt> &QGhostVtx,
-					     vector<MilanLongInt> &QMsgType,
-					     vector<MilanInt> &QOwner,
-					     vector<MilanLongInt> &privateQLocalVtx,
-					     vector<MilanLongInt> &privateQGhostVtx,
-					     vector<MilanLongInt> &privateQMsgType,
-					     vector<MilanInt> &privateQOwner,
-					     MPI_Comm comm,
-					     MilanLongInt *msgActual,
-					     vector<MilanLongInt> &Message);
-  
-  void sendBundledMessages(MilanLongInt *numGhostEdgesPtr,
-			   MilanInt *BufferSizePtr,
-			   MilanLongInt *Buffer,
-			   vector<MilanLongInt> &PCumulative,
-			   vector<MilanLongInt> &PMessageBundle,
-			   vector<MilanLongInt> &PSizeInfoMessages,
-			   MilanLongInt *PCounter,
-			   MilanLongInt NumMessagesBundled,
-			   MilanLongInt *msgActualPtr,
-			   MilanLongInt *MessageIndexPtr,
-			   MilanInt numProcs,
-			   MilanInt myRank,
-			   MPI_Comm comm,
-			   vector<MilanLongInt> &QLocalVtx,
-			   vector<MilanLongInt> &QGhostVtx,
-			   vector<MilanLongInt> &QMsgType,
-			   vector<MilanInt> &QOwner,
-			   vector<MPI_Request> &SRequest,
-			   vector<MPI_Status> &SStatus);
-  
-  void processMessagesD(
-		       MilanLongInt NLVer,
-		       MilanLongInt *Mate,
-		       MilanLongInt *candidateMate,
-		       map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-		       vector<MilanLongInt> &GMate,
-		       vector<MilanLongInt> &Counter,
-		       MilanLongInt StartIndex,
-		       MilanLongInt EndIndex,
-		       MilanLongInt *myCardPtr,
-		       MilanLongInt *msgIndPtr,
-		       MilanLongInt *msgActualPtr,
-		       MilanReal *edgeLocWeight,
-		       MilanLongInt *verDistance,
-		       MilanLongInt *verLocPtr,
-		       MilanLongInt k,
-		       MilanLongInt *verLocInd,
-		       MilanInt numProcs,
-		       MilanInt myRank,
-		       MPI_Comm comm,
-		       vector<MilanLongInt> &Message,
-		       MilanLongInt numGhostEdges,
-		       MilanLongInt u,
-		       MilanLongInt v,
-		       MilanLongInt *SPtr,
-		       vector<MilanLongInt> &U);
-  
-  void extractUChunk(
-		     vector<MilanLongInt> &UChunkBeingProcessed,
-		     vector<MilanLongInt> &U,
-		     vector<MilanLongInt> &privateU);
+    void queuesTransfer(vector<MilanLongInt> &U,
+                        vector<MilanLongInt> &privateU,
+                        vector<MilanLongInt> &QLocalVtx,
+                        vector<MilanLongInt> &QGhostVtx,
+                        vector<MilanLongInt> &QMsgType,
+                        vector<MilanInt> &QOwner,
+                        vector<MilanLongInt> &privateQLocalVtx,
+                        vector<MilanLongInt> &privateQGhostVtx,
+                        vector<MilanLongInt> &privateQMsgType,
+                        vector<MilanInt> &privateQOwner);
 
-  MilanLongInt firstComputeCandidateMateS(MilanLongInt adj1,
-					 MilanLongInt adj2,
-					 MilanLongInt *verLocInd,
-					  MilanFloat *edgeLocWeight);
+    bool isAlreadyMatched(MilanLongInt node,
+                          MilanLongInt StartIndex,
+                          MilanLongInt EndIndex,
+                          vector<MilanLongInt> &GMate,
+                          MilanLongInt *Mate,
+                          map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
 
-  MilanLongInt computeCandidateMateS(MilanLongInt adj1,
-				    MilanLongInt adj2,
-				    MilanFloat *edgeLocWeight,
-				    MilanLongInt k,
-				    MilanLongInt *verLocInd,
-				    MilanLongInt StartIndex,
-				    MilanLongInt EndIndex,
-				    vector<MilanLongInt> &GMate,
-				    MilanLongInt *Mate,
-				    map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
-  
-  void PARALLEL_COMPUTE_CANDIDATE_MATE_BS(MilanLongInt NLVer,
-					 MilanLongInt *verLocPtr,
-					 MilanLongInt *verLocInd,
-					 MilanInt myRank,
-					 MilanFloat *edgeLocWeight,
-					 MilanLongInt *candidateMate);
-  
-  void PARALLEL_PROCESS_EXPOSED_VERTEX_BS(MilanLongInt NLVer,
-					 MilanLongInt *candidateMate,
-					 MilanLongInt *verLocInd,
-					 MilanLongInt *verLocPtr,
-					 MilanLongInt StartIndex,
-					 MilanLongInt EndIndex,
-					 MilanLongInt *Mate,
-					 vector<MilanLongInt> &GMate,
-					 map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-					 MilanFloat *edgeLocWeight,
-					 MilanLongInt *myCardPtr,
-					 MilanLongInt *msgIndPtr,
-					 MilanLongInt *NumMessagesBundledPtr,
-					 MilanLongInt *SPtr,
-					 MilanLongInt *verDistance,
-					 MilanLongInt *PCounter,
-					 vector<MilanLongInt> &Counter,
-					 MilanInt myRank,
-					 MilanInt numProcs,
-					 vector<MilanLongInt> &U,
-					 vector<MilanLongInt> &privateU,
-					 vector<MilanLongInt> &QLocalVtx,
-					 vector<MilanLongInt> &QGhostVtx,
-					 vector<MilanLongInt> &QMsgType,
-					 vector<MilanInt> &QOwner,
-					 vector<MilanLongInt> &privateQLocalVtx,
-					 vector<MilanLongInt> &privateQGhostVtx,
-					 vector<MilanLongInt> &privateQMsgType,
-					 vector<MilanInt> &privateQOwner);
-  void processMatchedVerticesS(
-			      MilanLongInt NLVer,
-			      vector<MilanLongInt> &UChunkBeingProcessed,
-			      vector<MilanLongInt> &U,
-			      vector<MilanLongInt> &privateU,
-			      MilanLongInt StartIndex,
-			      MilanLongInt EndIndex,
-			      MilanLongInt *myCardPtr,
-			      MilanLongInt *msgIndPtr,
-			      MilanLongInt *NumMessagesBundledPtr,
-			      MilanLongInt *SPtr,
-			      MilanLongInt *verLocPtr,
-			      MilanLongInt *verLocInd,
-			      MilanLongInt *verDistance,
-			      MilanLongInt *PCounter,
-			      vector<MilanLongInt> &Counter,
-			      MilanInt myRank,
-			      MilanInt numProcs,
-			      MilanLongInt *candidateMate,
-			      vector<MilanLongInt> &GMate,
-			      MilanLongInt *Mate,
-			      map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-			      MilanFloat *edgeLocWeight,
-			      vector<MilanLongInt> &QLocalVtx,
-			      vector<MilanLongInt> &QGhostVtx,
-			      vector<MilanLongInt> &QMsgType,
-			      vector<MilanInt> &QOwner,
-			      vector<MilanLongInt> &privateQLocalVtx,
-			      vector<MilanLongInt> &privateQGhostVtx,
-			      vector<MilanLongInt> &privateQMsgType,
-			      vector<MilanInt> &privateQOwner);
-  
-  void processMatchedVerticesAndSendMessagesS(
-					     MilanLongInt NLVer,
-					     vector<MilanLongInt> &UChunkBeingProcessed,
-					     vector<MilanLongInt> &U,
-					     vector<MilanLongInt> &privateU,
-					     MilanLongInt StartIndex,
-					     MilanLongInt EndIndex,
-					     MilanLongInt *myCardPtr,
-					     MilanLongInt *msgIndPtr,
-					     MilanLongInt *NumMessagesBundledPtr,
-					     MilanLongInt *SPtr,
-					     MilanLongInt *verLocPtr,
-					     MilanLongInt *verLocInd,
-					     MilanLongInt *verDistance,
-					     MilanLongInt *PCounter,
-					     vector<MilanLongInt> &Counter,
-					     MilanInt myRank,
-					     MilanInt numProcs,
-					     MilanLongInt *candidateMate,
-					     vector<MilanLongInt> &GMate,
-					     MilanLongInt *Mate,
-					     map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-					     MilanFloat *edgeLocWeight,
-					     vector<MilanLongInt> &QLocalVtx,
-					     vector<MilanLongInt> &QGhostVtx,
-					     vector<MilanLongInt> &QMsgType,
-					     vector<MilanInt> &QOwner,
-					     vector<MilanLongInt> &privateQLocalVtx,
-					     vector<MilanLongInt> &privateQGhostVtx,
-					     vector<MilanLongInt> &privateQMsgType,
-					     vector<MilanInt> &privateQOwner,
-					     MPI_Comm comm,
-					     MilanLongInt *msgActual,
-					     vector<MilanLongInt> &Message);
-  
-  void processMessagesS(
-		       MilanLongInt NLVer,
-		       MilanLongInt *Mate,
-		       MilanLongInt *candidateMate,
-		       map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
-		       vector<MilanLongInt> &GMate,
-		       vector<MilanLongInt> &Counter,
-		       MilanLongInt StartIndex,
-		       MilanLongInt EndIndex,
-		       MilanLongInt *myCardPtr,
-		       MilanLongInt *msgIndPtr,
-		       MilanLongInt *msgActualPtr,
-		       MilanFloat *edgeLocWeight,
-		       MilanLongInt *verDistance,
-		       MilanLongInt *verLocPtr,
-		       MilanLongInt k,
-		       MilanLongInt *verLocInd,
-		       MilanInt numProcs,
-		       MilanInt myRank,
-		       MPI_Comm comm,
-		       vector<MilanLongInt> &Message,
-		       MilanLongInt numGhostEdges,
-		       MilanLongInt u,
-		       MilanLongInt v,
-		       MilanLongInt *SPtr,
-		       vector<MilanLongInt> &U);
-  
-  
-  void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
-			 MilanLongInt NLVer, MilanLongInt NLEdge,
-			 MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
-			 MilanLongInt *verDistance,
-			 MilanLongInt *Mate,
-			 MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
-			 MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
-			 MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
-			 MilanLongInt *ph1_card, MilanLongInt *ph2_card);
+    MilanLongInt computeCandidateMate(MilanLongInt adj1,
+                                      MilanLongInt adj2,
+                                      MilanReal *edgeLocWeight,
+                                      MilanLongInt k,
+                                      MilanLongInt *verLocInd,
+                                      MilanLongInt StartIndex,
+                                      MilanLongInt EndIndex,
+                                      vector<MilanLongInt> &GMate,
+                                      MilanLongInt *Mate,
+                                      map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
 
-  
-  void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
-			 MilanLongInt NLVer, MilanLongInt NLEdge,
-			 MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanFloat *edgeLocWeight,
-			 MilanLongInt *verDistance,
-			 MilanLongInt *Mate,
-			 MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
-			 MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
-			 MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
-			 MilanLongInt *ph1_card, MilanLongInt *ph2_card);
+    void initialize(MilanLongInt NLVer, MilanLongInt NLEdge,
+                    MilanLongInt StartIndex, MilanLongInt EndIndex,
+                    MilanLongInt *numGhostEdgesPtr,
+                    MilanLongInt *numGhostVerticesPtr,
+                    MilanLongInt *S,
+                    MilanLongInt *verLocInd,
+                    MilanLongInt *verLocPtr,
+                    map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+                    vector<MilanLongInt> &Counter,
+                    vector<MilanLongInt> &verGhostPtr,
+                    vector<MilanLongInt> &verGhostInd,
+                    vector<MilanLongInt> &tempCounter,
+                    vector<MilanLongInt> &GMate,
+                    vector<MilanLongInt> &Message,
+                    vector<MilanLongInt> &QLocalVtx,
+                    vector<MilanLongInt> &QGhostVtx,
+                    vector<MilanLongInt> &QMsgType,
+                    vector<MilanInt> &QOwner,
+                    MilanLongInt *&candidateMate,
+                    vector<MilanLongInt> &U,
+                    vector<MilanLongInt> &privateU,
+                    vector<MilanLongInt> &privateQLocalVtx,
+                    vector<MilanLongInt> &privateQGhostVtx,
+                    vector<MilanLongInt> &privateQMsgType,
+                    vector<MilanInt> &privateQOwner);
 
+    void clean(MilanLongInt NLVer,
+               MilanInt myRank,
+               MilanLongInt MessageIndex,
+               vector<MPI_Request> &SRequest,
+               vector<MPI_Status> &SStatus,
+               MilanInt BufferSize,
+               MilanLongInt *Buffer,
+               MilanLongInt msgActual,
+               MilanLongInt *msgActualSent,
+               MilanLongInt msgInd,
+               MilanLongInt *msgIndSent,
+               MilanLongInt NumMessagesBundled,
+               MilanReal *msgPercent);
 
+    void PARALLEL_COMPUTE_CANDIDATE_MATE_B(MilanLongInt NLVer,
+                                           MilanLongInt *verLocPtr,
+                                           MilanLongInt *verLocInd,
+                                           MilanInt myRank,
+                                           MilanReal *edgeLocWeight,
+                                           MilanLongInt *candidateMate);
+
+    void PARALLEL_PROCESS_EXPOSED_VERTEX_B(MilanLongInt NLVer,
+                                           MilanLongInt *candidateMate,
+                                           MilanLongInt *verLocInd,
+                                           MilanLongInt *verLocPtr,
+                                           MilanLongInt StartIndex,
+                                           MilanLongInt EndIndex,
+                                           MilanLongInt *Mate,
+                                           vector<MilanLongInt> &GMate,
+                                           map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+                                           MilanReal *edgeLocWeight,
+                                           MilanLongInt *myCardPtr,
+                                           MilanLongInt *msgIndPtr,
+                                           MilanLongInt *NumMessagesBundledPtr,
+                                           MilanLongInt *SPtr,
+                                           MilanLongInt *verDistance,
+                                           MilanLongInt *PCounter,
+                                           vector<MilanLongInt> &Counter,
+                                           MilanInt myRank,
+                                           MilanInt numProcs,
+                                           vector<MilanLongInt> &U,
+                                           vector<MilanLongInt> &privateU,
+                                           vector<MilanLongInt> &QLocalVtx,
+                                           vector<MilanLongInt> &QGhostVtx,
+                                           vector<MilanLongInt> &QMsgType,
+                                           vector<MilanInt> &QOwner,
+                                           vector<MilanLongInt> &privateQLocalVtx,
+                                           vector<MilanLongInt> &privateQGhostVtx,
+                                           vector<MilanLongInt> &privateQMsgType,
+                                           vector<MilanInt> &privateQOwner);
+
+    void PROCESS_CROSS_EDGE(MilanLongInt *edge,
+                            MilanLongInt *SPtr);
+
+    void processMatchedVertices(
+        MilanLongInt NLVer,
+        vector<MilanLongInt> &UChunkBeingProcessed,
+        vector<MilanLongInt> &U,
+        vector<MilanLongInt> &privateU,
+        MilanLongInt StartIndex,
+        MilanLongInt EndIndex,
+        MilanLongInt *myCardPtr,
+        MilanLongInt *msgIndPtr,
+        MilanLongInt *NumMessagesBundledPtr,
+        MilanLongInt *SPtr,
+        MilanLongInt *verLocPtr,
+        MilanLongInt *verLocInd,
+        MilanLongInt *verDistance,
+        MilanLongInt *PCounter,
+        vector<MilanLongInt> &Counter,
+        MilanInt myRank,
+        MilanInt numProcs,
+        MilanLongInt *candidateMate,
+        vector<MilanLongInt> &GMate,
+        MilanLongInt *Mate,
+        map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+        MilanReal *edgeLocWeight,
+        vector<MilanLongInt> &QLocalVtx,
+        vector<MilanLongInt> &QGhostVtx,
+        vector<MilanLongInt> &QMsgType,
+        vector<MilanInt> &QOwner,
+        vector<MilanLongInt> &privateQLocalVtx,
+        vector<MilanLongInt> &privateQGhostVtx,
+        vector<MilanLongInt> &privateQMsgType,
+        vector<MilanInt> &privateQOwner);
+
+    void processMatchedVerticesAndSendMessages(
+        MilanLongInt NLVer,
+        vector<MilanLongInt> &UChunkBeingProcessed,
+        vector<MilanLongInt> &U,
+        vector<MilanLongInt> &privateU,
+        MilanLongInt StartIndex,
+        MilanLongInt EndIndex,
+        MilanLongInt *myCardPtr,
+        MilanLongInt *msgIndPtr,
+        MilanLongInt *NumMessagesBundledPtr,
+        MilanLongInt *SPtr,
+        MilanLongInt *verLocPtr,
+        MilanLongInt *verLocInd,
+        MilanLongInt *verDistance,
+        MilanLongInt *PCounter,
+        vector<MilanLongInt> &Counter,
+        MilanInt myRank,
+        MilanInt numProcs,
+        MilanLongInt *candidateMate,
+        vector<MilanLongInt> &GMate,
+        MilanLongInt *Mate,
+        map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+        MilanReal *edgeLocWeight,
+        vector<MilanLongInt> &QLocalVtx,
+        vector<MilanLongInt> &QGhostVtx,
+        vector<MilanLongInt> &QMsgType,
+        vector<MilanInt> &QOwner,
+        vector<MilanLongInt> &privateQLocalVtx,
+        vector<MilanLongInt> &privateQGhostVtx,
+        vector<MilanLongInt> &privateQMsgType,
+        vector<MilanInt> &privateQOwner,
+        MPI_Comm comm,
+        MilanLongInt *msgActual,
+        vector<MilanLongInt> &Message);
+
+    void sendBundledMessages(MilanLongInt *numGhostEdgesPtr,
+                             MilanInt *BufferSizePtr,
+                             MilanLongInt *Buffer,
+                             vector<MilanLongInt> &PCumulative,
+                             vector<MilanLongInt> &PMessageBundle,
+                             vector<MilanLongInt> &PSizeInfoMessages,
+                             MilanLongInt *PCounter,
+                             MilanLongInt NumMessagesBundled,
+                             MilanLongInt *msgActualPtr,
+                             MilanLongInt *MessageIndexPtr,
+                             MilanInt numProcs,
+                             MilanInt myRank,
+                             MPI_Comm comm,
+                             vector<MilanLongInt> &QLocalVtx,
+                             vector<MilanLongInt> &QGhostVtx,
+                             vector<MilanLongInt> &QMsgType,
+                             vector<MilanInt> &QOwner,
+                             vector<MPI_Request> &SRequest,
+                             vector<MPI_Status> &SStatus);
+
+    void processMessages(
+        MilanLongInt NLVer,
+        MilanLongInt *Mate,
+        MilanLongInt *candidateMate,
+        map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
+        vector<MilanLongInt> &GMate,
+        vector<MilanLongInt> &Counter,
+        MilanLongInt StartIndex,
+        MilanLongInt EndIndex,
+        MilanLongInt *myCardPtr,
+        MilanLongInt *msgIndPtr,
+        MilanLongInt *msgActualPtr,
+        MilanReal *edgeLocWeight,
+        MilanLongInt *verDistance,
+        MilanLongInt *verLocPtr,
+        MilanLongInt k,
+        MilanLongInt *verLocInd,
+        MilanInt numProcs,
+        MilanInt myRank,
+        MPI_Comm comm,
+        vector<MilanLongInt> &Message,
+        MilanLongInt numGhostEdges,
+        MilanLongInt u,
+        MilanLongInt v,
+        MilanLongInt *SPtr,
+        vector<MilanLongInt> &U);
+
+    void extractUChunk(
+        vector<MilanLongInt> &UChunkBeingProcessed,
+        vector<MilanLongInt> &U,
+        vector<MilanLongInt> &privateU);
+
+    void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
+        MilanLongInt NLVer, MilanLongInt NLEdge,
+        MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
+        MilanLongInt *verDistance,
+        MilanLongInt *Mate,
+        MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
+        MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
+        MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
+        MilanLongInt *ph1_card, MilanLongInt *ph2_card);
 
     void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
         MilanLongInt NLVer, MilanLongInt NLEdge,

amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.cpp

@@ -1303,16 +1303,16 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
 // SINGLE PRECISION VERSION
 
 void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
-      MilanLongInt NLVer, MilanLongInt NLEdge,
-      MilanLongInt* verLocPtr, MilanLongInt* verLocInd,
-      MilanFloat* edgeLocWeight,
-      MilanLongInt* verDistance,
-      MilanLongInt* Mate,
-      MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
-      MilanLongInt* msgIndSent, MilanLongInt* msgActualSent,
-      MilanReal* msgPercent,
-      MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
-      MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
+                                                              MilanLongInt NLVer, MilanLongInt NLEdge,
+                                                              MilanLongInt* verLocPtr, MilanLongInt* verLocInd,
+							      MilanFloat* edgeLocWeight,
+                                                              MilanLongInt* verDistance,
+                                                              MilanLongInt* Mate,
+                                                              MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
+                                                              MilanLongInt* msgIndSent, MilanLongInt* msgActualSent,
+							      MilanReal* msgPercent,
+                                                              MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
+                                                              MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
 #if !defined(SERIAL_MPI)
 #ifdef PRINT_DEBUG_INFO_
     cout<<"\n("<<myRank<<")Within algoEdgeApproxDominatingEdgesLinearSearchMessageBundling()"; fflush(stdout);

amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.cpp

@@ -1,4 +1,5 @@
 #include "MatchBoxPC.h"
+
 // ***********************************************************************
 //
 //        MatchboxP: A C++ library for approximate weighted matching
@@ -125,10 +126,8 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
     fflush(stdout);
 #endif
 
-    // The starting vertex owned by the current rank
-    MilanLongInt StartIndex = verDistance[myRank];
-    // The ending vertex owned by the current rank
-    MilanLongInt EndIndex   = verDistance[myRank + 1] - 1;
+    MilanLongInt StartIndex = verDistance[myRank];       // The starting vertex owned by the current rank
+    MilanLongInt EndIndex   = verDistance[myRank + 1] - 1; // The ending vertex owned by the current rank
 
     MPI_Status computeStatus;
 
@@ -146,8 +145,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
     // only one message will be sent in the initialization phase -
     // one of: REQUEST/FAILURE/SUCCESS
     vector<MilanLongInt> QLocalVtx, QGhostVtx, QMsgType;
-    // Changed by Fabio to be an integer, addresses needs to be integers!
-    vector<MilanInt> QOwner; 
+    vector<MilanInt> QOwner; // Changed by Fabio to be an integer, addresses needs to be integers!
 
     MilanLongInt *PCounter = new MilanLongInt[numProcs];
     for (int i = 0; i < numProcs; i++)
@@ -155,8 +153,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
 
     MilanLongInt NumMessagesBundled = 0;
     // TODO when the last computational section will be refactored this could be eliminated
-    // Changed by Fabio to be an integer, addresses needs to be integers!
-    MilanInt ghostOwner = 0; 
+    MilanInt ghostOwner = 0; // Changed by Fabio to be an integer, addresses needs to be integers!
     MilanLongInt *candidateMate = nullptr;
 #ifdef PRINT_DEBUG_INFO_
     cout << "\n(" << myRank << ")NV: " << NLVer << "  Edges: " << NLEdge;
@@ -171,12 +168,9 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
     MilanLongInt myCard = 0;
 
     // Build the Ghost Vertex Set: Vg
-    // Map each ghost vertex to a local vertex
-    map<MilanLongInt, MilanLongInt> Ghost2LocalMap;
-    // Store the edge count for each ghost vertex
-    vector<MilanLongInt> Counter;
-    // Number of Ghost vertices
-    MilanLongInt numGhostVertices = 0, numGhostEdges = 0; 
+    map<MilanLongInt, MilanLongInt> Ghost2LocalMap;       // Map each ghost vertex to a local vertex
+    vector<MilanLongInt> Counter;                         // Store the edge count for each ghost vertex
+    MilanLongInt numGhostVertices = 0, numGhostEdges = 0; // Number of Ghost vertices
 
 #ifdef PRINT_DEBUG_INFO_
     cout << "\n(" << myRank << ")About to compute Ghost Vertices...";
@@ -228,7 +222,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
     cout << myRank << " Finished initialization" << endl;
     fflush(stdout);
 #endif
-
+   
     startTime = MPI_Wtime();
 
     /////////////////////////////////////////////////////////////////////////////////////////
@@ -243,7 +237,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
      * PARALLEL_COMPUTE_CANDIDATE_MATE_B is now totally parallel.
      */
 
-    PARALLEL_COMPUTE_CANDIDATE_MATE_BD(NLVer,
+    PARALLEL_COMPUTE_CANDIDATE_MATE_B(NLVer,
                                       verLocPtr,
                                       verLocInd,
                                       myRank,
@@ -268,7 +262,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
      * TODO: Test when it's actually more efficient to execute this code
      *       in parallel.
      */
-    PARALLEL_PROCESS_EXPOSED_VERTEX_BD(NLVer,
+    PARALLEL_PROCESS_EXPOSED_VERTEX_B(NLVer,
                                       candidateMate,
                                       verLocInd,
                                       verLocPtr,
@@ -320,7 +314,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
     vector<MilanLongInt> UChunkBeingProcessed;
     UChunkBeingProcessed.reserve(UCHUNK);
 
-    processMatchedVerticesD(NLVer,
+    processMatchedVertices(NLVer,
                            UChunkBeingProcessed,
                            U,
                            privateU,
@@ -397,7 +391,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
     cout << myRank << " Finished sendBundles" << endl;
     fflush(stdout);
 #endif
-
+ 
     *ph1_card = myCard;                 // Cardinality at the end of Phase-1
     startTime = MPI_Wtime();
     /////////////////////////////////////////////////////////////////////////////////////////
@@ -428,8 +422,8 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
         ///////////////////////////////////////////////////////////////////////////////////
         /////////////////////////// PROCESS MATCHED VERTICES //////////////////////////////
         ///////////////////////////////////////////////////////////////////////////////////
-
-      processMatchedVerticesAndSendMessagesD(NLVer,
+      
+      processMatchedVerticesAndSendMessages(NLVer,
 					    UChunkBeingProcessed,
 					    U,
 					    privateU,
@@ -462,7 +456,7 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
 					    comm,
 					    &msgActual,
 					    Message);
-
+      
       ///////////////////////// END OF PROCESS MATCHED VERTICES /////////////////////////
 
         //// BREAK IF NO MESSAGES EXPECTED /////////
@@ -489,8 +483,8 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
         ///////////////////////////////////////////////////////////////////////////////////
         /////////////////////////// PROCESS MESSAGES //////////////////////////////////////
         ///////////////////////////////////////////////////////////////////////////////////
-	//startTime = MPI_Wtime();
-        processMessagesD(NLVer,
+
+        processMessages(NLVer,
                         Mate,
                         candidateMate,
                         Ghost2LocalMap,
@@ -555,489 +549,6 @@ void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
     *ph2_card = myCard;                 // Cardinality at the end of Phase-2
 }
 // End of algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMate
-
-void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
-    MilanLongInt NLVer, MilanLongInt NLEdge,
-    MilanLongInt *verLocPtr, MilanLongInt *verLocInd,
-    MilanFloat *edgeLocWeight,
-    MilanLongInt *verDistance,
-    MilanLongInt *Mate,
-    MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
-    MilanLongInt *msgIndSent, MilanLongInt *msgActualSent,
-    MilanReal *msgPercent,
-    MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
-    MilanLongInt *ph1_card, MilanLongInt *ph2_card)
-{
-
-    /*
-     * verDistance: it's a vector long as the number of processors.
-     *              verDistance[i] contains the first node index of the i-th processor
-     *              verDistance[i + 1] contains the last node index of the i-th processor
-     * NLVer: number of elements in the LocPtr
-     * NLEdge: number of edges assigned to the current processor
-     *
-     * Contains the portion of matrix assigned to the processor in
-     * Yale notation
-     * verLocInd: contains the positions on row of the matrix
-     * verLocPtr: i-th value is the position of the first element on the i-th row and
-     *            i+1-th value is the position of the first element on the i+1-th row
-     */
-
-#if !defined(SERIAL_MPI)
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ")Within algoEdgeApproxDominatingEdgesLinearSearchMessageBundling()";
-    fflush(stdout);
-#endif
-
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ") verDistance [" ;
-    for (int i = 0; i < numProcs; i++)
-      cout << verDistance[i] << "," << verDistance[i+1];
-    cout  << "]\n";
-    fflush(stdout);
-#endif
-#ifdef DEBUG_HANG_
-    if (myRank == 0) {
-      cout << "\n(" << myRank << ") verDistance [" ;
-      for (int i = 0; i < numProcs; i++)
-	cout << verDistance[i] << "," ;
-      cout  << verDistance[numProcs]<< "]\n";
-    }
-    fflush(stdout);
-#endif
-
-    // The starting vertex owned by the current rank
-    MilanLongInt StartIndex = verDistance[myRank];
-    // The ending vertex owned by the current rank
-    MilanLongInt EndIndex   = verDistance[myRank + 1] - 1;
-
-    MPI_Status computeStatus;
-
-    MilanLongInt msgActual = 0, msgInd = 0;
-    MilanFloat heaviestEdgeWt = 0.0f; // Assumes positive weight
-    MilanReal startTime, finishTime;
-
-    startTime = MPI_Wtime();
-
-    // Data structures for sending and receiving messages:
-    vector<MilanLongInt> Message; // [ u, v, message_type ]
-    Message.resize(3, -1);
-    // Data structures for Message Bundling:
-    // Although up to two messages can be sent along any cross edge,
-    // only one message will be sent in the initialization phase -
-    // one of: REQUEST/FAILURE/SUCCESS
-    vector<MilanLongInt> QLocalVtx, QGhostVtx, QMsgType;
-    // Changed by Fabio to be an integer, addresses needs to be integers!
-    vector<MilanInt> QOwner; 
-
-    MilanLongInt *PCounter = new MilanLongInt[numProcs];
-    for (int i = 0; i < numProcs; i++)
-        PCounter[i] = 0;
-
-    MilanLongInt NumMessagesBundled = 0;
-    // TODO when the last computational section will be refactored this could be eliminated
-    // Changed by Fabio to be an integer, addresses needs to be integers!
-    MilanInt ghostOwner = 0; 
-    MilanLongInt *candidateMate = nullptr;
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ")NV: " << NLVer << "  Edges: " << NLEdge;
-    fflush(stdout);
-    cout << "\n(" << myRank << ")StartIndex: " << StartIndex << "  EndIndex: " << EndIndex;
-    fflush(stdout);
-#endif
-    // Other Variables:
-    MilanLongInt u = -1, v = -1, w = -1, i = 0;
-    MilanLongInt k = -1, adj1 = -1, adj2 = -1;
-    MilanLongInt k1 = -1, adj11 = -1, adj12 = -1;
-    MilanLongInt myCard = 0;
-
-    // Build the Ghost Vertex Set: Vg
-    // Map each ghost vertex to a local vertex
-    map<MilanLongInt, MilanLongInt> Ghost2LocalMap;
-    // Store the edge count for each ghost vertex
-    vector<MilanLongInt> Counter;
-    // Number of Ghost vertices
-    MilanLongInt numGhostVertices = 0, numGhostEdges = 0; 
-
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ")About to compute Ghost Vertices...";
-    fflush(stdout);
-#endif
-#ifdef DEBUG_HANG_
-    if (myRank == 0)
-        cout << "\n(" << myRank << ")About to compute Ghost Vertices...";
-    fflush(stdout);
-#endif
-
-    // Define Adjacency Lists for Ghost Vertices:
-    // cout<<"Building Ghost data structures ... \n\n";
-    vector<MilanLongInt> verGhostPtr, verGhostInd, tempCounter;
-    // Mate array for ghost vertices:
-    vector<MilanLongInt> GMate; // Proportional to the number of ghost vertices
-    MilanLongInt S;
-    MilanLongInt privateMyCard = 0;
-    vector<MilanLongInt> PCumulative, PMessageBundle, PSizeInfoMessages;
-    vector<MPI_Request> SRequest;  // Requests that are used for each send message
-    vector<MPI_Status> SStatus;    // Status of sent messages, used in MPI_Wait
-    MilanLongInt MessageIndex = 0; // Pointer for current message
-    MilanInt BufferSize;
-    MilanLongInt *Buffer;
-
-    vector<MilanLongInt> privateQLocalVtx, privateQGhostVtx, privateQMsgType;
-    vector<MilanInt> privateQOwner;
-    vector<MilanLongInt> U, privateU;
-
-    
-    initialize(NLVer, NLEdge, StartIndex,
-               EndIndex, &numGhostEdges,
-               &numGhostVertices, &S,
-               verLocInd, verLocPtr,
-               Ghost2LocalMap, Counter,
-               verGhostPtr, verGhostInd,
-               tempCounter, GMate,
-               Message, QLocalVtx,
-               QGhostVtx, QMsgType, QOwner,
-               candidateMate, U,
-               privateU,
-               privateQLocalVtx,
-               privateQGhostVtx,
-               privateQMsgType,
-               privateQOwner);
-
-    finishTime = MPI_Wtime();
-    *ph0_time = finishTime - startTime; // Time taken for Phase-0: Initialization
-#ifdef DEBUG_HANG_
-    cout << myRank << " Finished initialization" << endl;
-    fflush(stdout);
-#endif
-
-    startTime = MPI_Wtime();
-
-    /////////////////////////////////////////////////////////////////////////////////////////
-    //////////////////////////////////// INITIALIZATION /////////////////////////////////////
-    /////////////////////////////////////////////////////////////////////////////////////////
-    // Compute the Initial Matching Set:
-
-    /*
-     * OMP PARALLEL_COMPUTE_CANDIDATE_MATE_B has been splitted from
-     * PARALLEL_PROCESS_EXPOSED_VERTEX_B in order to better parallelize
-     * the two.
-     * PARALLEL_COMPUTE_CANDIDATE_MATE_B is now totally parallel.
-     */
-
-    PARALLEL_COMPUTE_CANDIDATE_MATE_BS(NLVer,
-                                      verLocPtr,
-                                      verLocInd,
-                                      myRank,
-                                      edgeLocWeight,
-                                      candidateMate);
-
-#ifdef DEBUG_HANG_
-    cout << myRank << " Finished Exposed Vertex" << endl;
-    fflush(stdout);
-#if 0
-    cout << myRank << " candidateMate after parallelCompute " <<endl;
-    for (int i=0; i<NLVer; i++) {
-      cout << candidateMate[i] << " " ;
-    }
-    cout << endl;
-#endif
-#endif
-    /*
-     * PARALLEL_PROCESS_EXPOSED_VERTEX_B
-     * TODO: write comment
-     *
-     * TODO: Test when it's actually more efficient to execute this code
-     *       in parallel.
-     */
-    PARALLEL_PROCESS_EXPOSED_VERTEX_BS(NLVer,
-                                      candidateMate,
-                                      verLocInd,
-                                      verLocPtr,
-                                      StartIndex,
-                                      EndIndex,
-                                      Mate,
-                                      GMate,
-                                      Ghost2LocalMap,
-                                      edgeLocWeight,
-                                      &myCard,
-                                      &msgInd,
-                                      &NumMessagesBundled,
-                                      &S,
-                                      verDistance,
-                                      PCounter,
-                                      Counter,
-                                      myRank,
-                                      numProcs,
-                                      U,
-                                      privateU,
-                                      QLocalVtx,
-                                      QGhostVtx,
-                                      QMsgType,
-                                      QOwner,
-                                      privateQLocalVtx,
-                                      privateQGhostVtx,
-                                      privateQMsgType,
-                                      privateQOwner);
-
-    tempCounter.clear(); // Do not need this any more
-
-#ifdef DEBUG_HANG_
-    cout << myRank << " Finished Exposed Vertex" << endl;
-    fflush(stdout);
-#if 0
-    cout << myRank << " Mate after Exposed Vertices " <<endl;
-    for (int i=0; i<NLVer; i++) {
-      cout << Mate[i] << " " ;
-    }
-    cout << endl;
-#endif
-#endif
-
-    ///////////////////////////////////////////////////////////////////////////////////
-    /////////////////////////// PROCESS MATCHED VERTICES //////////////////////////////
-    ///////////////////////////////////////////////////////////////////////////////////
-
-    // TODO what would be the optimal UCHUNK
-    vector<MilanLongInt> UChunkBeingProcessed;
-    UChunkBeingProcessed.reserve(UCHUNK);
-
-    processMatchedVerticesS(NLVer,
-                           UChunkBeingProcessed,
-                           U,
-                           privateU,
-                           StartIndex,
-                           EndIndex,
-                           &myCard,
-                           &msgInd,
-                           &NumMessagesBundled,
-                           &S,
-                           verLocPtr,
-                           verLocInd,
-                           verDistance,
-                           PCounter,
-                           Counter,
-                           myRank,
-                           numProcs,
-                           candidateMate,
-                           GMate,
-                           Mate,
-                           Ghost2LocalMap,
-                           edgeLocWeight,
-                           QLocalVtx,
-                           QGhostVtx,
-                           QMsgType,
-                           QOwner,
-                           privateQLocalVtx,
-                           privateQGhostVtx,
-                           privateQMsgType,
-                           privateQOwner);
-
-
-#ifdef DEBUG_HANG_
-    cout << myRank << " Finished Process Vertices" << endl;
-    fflush(stdout);
-#if 0
-    cout << myRank << " Mate after Matched Vertices " <<endl;
-    for (int i=0; i<NLVer; i++) {
-      cout << Mate[i] << " " ;
-    }
-    cout << endl;
-#endif
-#endif
-
-    /////////////////////////////////////////////////////////////////////////////////////////
-    ///////////////////////////// SEND BUNDLED MESSAGES /////////////////////////////////////
-    /////////////////////////////////////////////////////////////////////////////////////////
-
-    sendBundledMessages(&numGhostEdges,
-                        &BufferSize,
-                        Buffer,
-                        PCumulative,
-                        PMessageBundle,
-                        PSizeInfoMessages,
-                        PCounter,
-                        NumMessagesBundled,
-                        &msgActual,
-                        &MessageIndex,
-                        numProcs,
-                        myRank,
-                        comm,
-                        QLocalVtx,
-                        QGhostVtx,
-                        QMsgType,
-                        QOwner,
-                        SRequest,
-                        SStatus);
-
-    ///////////////////////// END OF SEND BUNDLED MESSAGES //////////////////////////////////
-
-    finishTime = MPI_Wtime();
-    *ph1_time = finishTime - startTime; // Time taken for Phase-1
-
-#ifdef DEBUG_HANG_
-    cout << myRank << " Finished sendBundles" << endl;
-    fflush(stdout);
-#endif
-
-    *ph1_card = myCard;                 // Cardinality at the end of Phase-1
-    startTime = MPI_Wtime();
-    /////////////////////////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////// MAIN LOOP //////////////////////////////////////
-    /////////////////////////////////////////////////////////////////////////////////////////
-    // Main While Loop:
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << "=========================************===============================" << endl;
-    fflush(stdout);
-    fflush(stdout);
-#endif
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << ")Entering While(true) loop..";
-    fflush(stdout);
-#endif
-#ifdef PRINT_DEBUG_INFO_
-    cout << "\n(" << myRank << "=========================************===============================" << endl;
-    fflush(stdout);
-    fflush(stdout);
-#endif
-
-    while (true)  {
-#ifdef DEBUG_HANG_
-      //if (myRank == 0)
-      cout << "\n(" << myRank << ") Main loop" << endl;
-      fflush(stdout);
-#endif
-        ///////////////////////////////////////////////////////////////////////////////////
-        /////////////////////////// PROCESS MATCHED VERTICES //////////////////////////////
-        ///////////////////////////////////////////////////////////////////////////////////
-
-      processMatchedVerticesAndSendMessagesS(NLVer,
-					    UChunkBeingProcessed,
-					    U,
-					    privateU,
-					    StartIndex,
-					    EndIndex,
-					    &myCard,
-					    &msgInd,
-					    &NumMessagesBundled,
-					    &S,
-					    verLocPtr,
-					    verLocInd,
-					    verDistance,
-					    PCounter,
-					    Counter,
-					    myRank,
-					    numProcs,
-					    candidateMate,
-					    GMate,
-					    Mate,
-					    Ghost2LocalMap,
-					    edgeLocWeight,
-					    QLocalVtx,
-					    QGhostVtx,
-					    QMsgType,
-					    QOwner,
-					    privateQLocalVtx,
-					    privateQGhostVtx,
-					    privateQMsgType,
-					    privateQOwner,
-					    comm,
-					    &msgActual,
-					    Message);
-
-      ///////////////////////// END OF PROCESS MATCHED VERTICES /////////////////////////
-
-        //// BREAK IF NO MESSAGES EXPECTED /////////
-#ifdef DEBUG_HANG_
-#if 0
-      cout << myRank << " Mate after ProcessMatchedAndSend phase "<<S <<endl;
-      for (int i=0; i<NLVer; i++) {
-	cout << Mate[i] << " " ;
-      }
-      cout << endl;
-#endif
-#endif
-#ifdef PRINT_DEBUG_INFO_
-        cout << "\n(" << myRank << ")Deciding whether to break: S= " << S << endl;
-#endif
-
-        if (S == 0) {
-#ifdef DEBUG_HANG_
-	  cout << "\n(" << myRank << ") Breaking out" << endl;
-	  fflush(stdout);
-#endif
-	  break;
-        }
-        ///////////////////////////////////////////////////////////////////////////////////
-        /////////////////////////// PROCESS MESSAGES //////////////////////////////////////
-        ///////////////////////////////////////////////////////////////////////////////////
-
-        processMessagesS(NLVer,
-                        Mate,
-                        candidateMate,
-                        Ghost2LocalMap,
-                        GMate,
-                        Counter,
-                        StartIndex,
-                        EndIndex,
-                        &myCard,
-                        &msgInd,
-                        &msgActual,
-                        edgeLocWeight,
-                        verDistance,
-                        verLocPtr,
-                        k,
-                        verLocInd,
-                        numProcs,
-                        myRank,
-                        comm,
-                        Message,
-                        numGhostEdges,
-                        u,
-                        v,
-                        &S,
-                        U);
-
-        ///////////////////////// END OF PROCESS MESSAGES /////////////////////////////////
-#ifdef DEBUG_HANG_
-#if 0
-      cout << myRank << " Mate after ProcessMessages phase "<<S <<endl;
-      for (int i=0; i<NLVer; i++) {
-	cout << Mate[i] << " " ;
-      }
-      cout << endl;
-#endif
-#endif
-#ifdef PRINT_DEBUG_INFO_
-        cout << "\n(" << myRank << ")Finished Message processing phase: S= " << S;
-        fflush(stdout);
-        cout << "\n(" << myRank << ")** SENT     : ACTUAL= " << msgActual;
-        fflush(stdout);
-        cout << "\n(" << myRank << ")** SENT     : INDIVIDUAL= " << msgInd << endl;
-        fflush(stdout);
-#endif
-    } // End of while (true)
-
-    clean(NLVer,
-          myRank,
-          MessageIndex,
-          SRequest,
-          SStatus,
-          BufferSize,
-          Buffer,
-          msgActual,
-          msgActualSent,
-          msgInd,
-          msgIndSent,
-          NumMessagesBundled,
-          msgPercent);
-
-    finishTime = MPI_Wtime();
-    *ph2_time = finishTime - startTime; // Time taken for Phase-2
-    *ph2_card = myCard;                 // Cardinality at the end of Phase-2
-}
-
 #endif
 
 #endif
-#endif

amgprec/impl/aggregator/amg_c_dec_aggregator_mat_bld.f90

@@ -177,24 +177,23 @@ subroutine  amg_c_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   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(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_) 
 
-    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(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)
+    call amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, &
+         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
   case default
     info = psb_err_internal_error_

amgprec/impl/aggregator/amg_c_ptap_bld.f90

@@ -76,7 +76,7 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   integer(psb_ipk_) :: nrow, ncol, nrl, nzl, ip, nzt, i, k
   integer(psb_lpk_) ::  nrsave, ncsave, nzsave, nza
   logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.  
-  integer(psb_ipk_), save :: idx_spspmm=-1, idx_cpytrans1=-1, idx_cpytrans2=-1
+  integer(psb_ipk_), save :: idx_spspmm=-1
 
   name='amg_ptap_bld'
   if(psb_get_errstatus().ne.0) return 
@@ -93,11 +93,7 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ncol  = desc_a%get_local_cols()
 
   if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("PTAP_BLD: par_spspmm")
-  if ((do_timings).and.(idx_cpytrans1==-1)) &
-       & idx_cpytrans1 = psb_get_timer_idx("PTAP_BLD: cpy&trans1")
-  if ((do_timings).and.(idx_cpytrans2==-1)) &
-       & idx_cpytrans2 = psb_get_timer_idx("PTAP_BLD: cpy&trans2")
+       & idx_spspmm = psb_get_timer_idx("SPMM_BLD: par_spspmm")
 
   naggr   = nlaggr(me+1)
   ntaggr  = sum(nlaggr)
@@ -132,7 +128,6 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ! Ok first product done.
 
   if (present(desc_ax)) then
-    if (do_timings) call psb_tic(idx_cpytrans1)
     block 
       call coo_prol%cp_to_coo(coo_restr,info)
       call coo_restr%set_ncols(desc_ac%get_local_cols())
@@ -142,7 +137,7 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
       call coo_restr%set_ncols(desc_ax%get_local_cols())
     end block
     call csr_restr%cp_from_coo(coo_restr,info)
-    if (do_timings) call psb_toc(idx_cpytrans1)
+
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999
@@ -172,28 +167,27 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
     call coo_restr%transp()
     nzl = coo_restr%get_nzeros()
-    nrl = desc_ac%get_local_rows()
-    call coo_restr%fix(info)
-    i=coo_restr%get_nzeros()
+    nrl = desc_ac%get_local_rows() 
+    i=0
     !
     ! Only keep local rows
     !
-    search: do k=i,1,-1
-      if (coo_restr%ia(k) <= nrl) then
-        call coo_restr%set_nzeros(k)
-        exit search
+    do k=1, nzl
+      if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then
+        i = i+1
+        coo_restr%val(i) = coo_restr%val(k)
+        coo_restr%ia(i)  = coo_restr%ia(k)
+        coo_restr%ja(i)  = coo_restr%ja(k)
       end if
-    end do search
-
+    end do
+    call coo_restr%set_nzeros(i)
+    call coo_restr%fix(info) 
     nzl  = coo_restr%get_nzeros()
     call coo_restr%set_nrows(desc_ac%get_local_rows())
     call coo_restr%set_ncols(desc_a%get_local_cols())
     if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
-    if (do_timings) call psb_tic(idx_cpytrans2)
-        
     call csr_restr%cp_from_coo(coo_restr,info)
 
-    if (do_timings) call psb_toc(idx_cpytrans2)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999

amgprec/impl/aggregator/amg_c_soc1_map_bld.f90

@@ -72,9 +72,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   use psb_base_mod
   use amg_base_prec_type
   use amg_c_inner_mod
-#if defined(OPENMP)
-  use omp_lib
-#endif
+
   implicit none
 
   ! Arguments
@@ -87,7 +85,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_), intent(out)               :: info
 
   ! Local variables
-  integer(psb_ipk_), allocatable :: neigh(:), irow(:), icol(:),&
+  integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:),&
        & ideg(:), idxs(:)
   integer(psb_lpk_), allocatable :: tmpaggr(:)
   complex(psb_spk_), allocatable  :: val(:), diag(:)
@@ -101,9 +99,6 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_)   :: nrow, ncol, n_ne
   integer(psb_lpk_)   :: nrglob
   character(len=20)   :: name, ch_err
-  integer(psb_ipk_), save :: idx_soc1_p1=-1, idx_soc1_p2=-1, idx_soc1_p3=-1
-  integer(psb_ipk_), save :: idx_soc1_p0=-1
-  logical, parameter      :: do_timings=.true.
 
   info=psb_success_
   name = 'amg_soc1_map_bld'
@@ -119,14 +114,6 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nrow   = desc_a%get_local_rows()
   ncol   = desc_a%get_local_cols()
   nrglob = desc_a%get_global_rows()
-  if ((do_timings).and.(idx_soc1_p0==-1))       &
-       & idx_soc1_p0 = psb_get_timer_idx("SOC1_MAP: phase0")
-  if ((do_timings).and.(idx_soc1_p1==-1))       &
-       & idx_soc1_p1 = psb_get_timer_idx("SOC1_MAP: phase1")
-  if ((do_timings).and.(idx_soc1_p2==-1))       &
-       & idx_soc1_p2 = psb_get_timer_idx("SOC1_MAP: phase2")
-  if ((do_timings).and.(idx_soc1_p3==-1))       &
-       & idx_soc1_p3 = psb_get_timer_idx("SOC1_MAP: phase3")
 
   nr = a%get_nrows()
   nc = a%get_ncols()
@@ -146,205 +133,41 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
     goto 9999
   end if
 
-  if (do_timings) call psb_tic(idx_soc1_p0)
   call a%cp_to(acsr)
-  if (do_timings) call psb_toc(idx_soc1_p0)
   if (clean_zeros) call acsr%clean_zeros(info)
   if (iorder == amg_aggr_ord_nat_) then 
-    !$omp parallel do private(i) schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
-      idxs(i)   = i
+      idxs(i)   = i 
     end do
-    !$omp end parallel do 
-  else
-    !$omp parallel do private(i) schedule(static)
+  else 
     do i=1, nr
       ilaggr(i) = -(nr+1)
       ideg(i)   = acsr%irp(i+1) - acsr%irp(i)
     end do
-    !$omp end parallel do 
     call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
   end if
-  if (do_timings) call psb_tic(idx_soc1_p1)
+
 
   !
   ! Phase one: Start with disjoint groups.
   ! 
   naggr = 0
-#if defined(OPENMP)
-  block
-    integer(psb_ipk_), allocatable  :: bnds(:), locnaggr(:)
-    integer(psb_ipk_) :: myth,nths, kk
-    ! The parallelization makes use of a locaggr(:) array; each thread
-    ! keeps its own version of naggr, and when the loop ends, a prefix is applied
-    ! to locnaggr to determine:
-    ! 1. The total number of aggregaters NAGGR;
-    ! 2. How much should each thread shift its own aggregates
-    ! Part 2 requires to keep track of which thread defined each entry
-    ! of ilaggr(), so that each entry can be adjusted correctly: even
-    ! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
-    ! been set because it is strongly connected to an entry J belonging to a
-    ! different thread. 
-
-    !$omp parallel shared(bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
-    !$omp private(icol,val,myth,kk) 
-    block
-      integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz, nc, i,j,m, nz, ilg,  ip, rsz
-      integer(psb_lpk_) :: itmp
-      !$omp master
-      nths = omp_get_num_threads()
-      allocate(bnds(0:nths),locnaggr(0:nths+1))
-      locnaggr(:) = 0
-      bnds(0) = 1
-      !$omp end master      
-      !$omp barrier
-      myth = omp_get_thread_num()
-      rsz = nr/nths
-      if (myth < mod(nr,nths)) rsz = rsz + 1
-      bnds(myth+1) = rsz
-      !$omp barrier
-      !$omp master
-      do i=1,nths
-        bnds(i) = bnds(i) + bnds(i-1)
-      end do
-      info = 0
-      !$omp end master
-      !$omp barrier
-      
-      !$omp do schedule(static) private(disjoint) 
-      do kk=0, nths-1
-        step1: do ii=bnds(kk), bnds(kk+1)-1
-          i = idxs(ii)          
-          if (info /= 0) cycle step1
-          if ((i<1).or.(i>nr)) then
-            !$omp atomic write
-            info=psb_err_internal_error_
-            !$omp end atomic 
-            call psb_errpush(info,name)
-            cycle step1
-            !goto 9999
-          end if
-            
-          if (ilaggr(i) == -(nr+1)) then
-            nz         = (acsr%irp(i+1)-acsr%irp(i))
-            if ((nz<0).or.(nz>size(icol))) then
-              !$omp atomic write
-              info=psb_err_internal_error_
-              !$omp end atomic 
-              call psb_errpush(info,name)
-              cycle step1
-              !goto 9999
-            end if
-
-            icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
-            val(1:nz)  = acsr%val(acsr%irp(i):acsr%irp(i+1)-1) 
-
-            !
-            ! Build the set of all strongly coupled nodes 
-            !
-            ip = 0
-            do k=1, nz
-              j   = icol(k)
-              ! If any of the neighbours is already assigned,
-              ! we will not reset. 
-              if (j>nr) cycle step1
-              if (ilaggr(j) > 0) cycle step1
-              if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.czero)) then
-                ip = ip + 1
-                icol(ip) = icol(k)
-              end if
-            enddo
-            
-            !
-            ! If the whole strongly coupled neighborhood of I is
-            ! as yet unconnected, turn it into the next aggregate.
-            ! Same if ip==0 (in which case, neighborhood only
-            ! contains I even if it does not look like it from matrix)
-            ! The fact that DISJOINT is private and not under lock
-            ! generates a certain un-repeatability, in that between
-            ! computing DISJOINT and assigning, another thread might
-            ! alter the values of ILAGGR.
-            ! However, a certain unrepeatability is already present
-            ! because the sequence of aggregates is computed with a
-            ! different order than in serial mode.
-            ! In any case, even if the enteries of ILAGGR may be
-            ! overwritten, the important thing is that each entry is
-            ! consistent and they generate a correct aggregation map.
-            !
-            disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
-            if (disjoint) then
-              locnaggr(kk)     = locnaggr(kk) + 1
-              itmp = (bnds(kk)-1+locnaggr(kk)) !be careful about overflow
-              itmp = itmp*nths+kk
-              if (itmp < (bnds(kk)-1+locnaggr(kk))) then
-                !$omp atomic update
-                info = max(12345678,info)
-                !$omp end atomic
-                cycle step1
-              end if
-              !$omp atomic write
-              ilaggr(i) = itmp
-              !$omp end atomic
-              do k=1, ip
-                !$omp atomic write
-                ilaggr(icol(k)) = itmp
-                !$omp end atomic
-              end do
-            end if
-          end if
-        enddo step1
-      end do
-      !$omp end do
-
-      !$omp master
-      naggr = sum(locnaggr(0:nths-1))
-      do i=1,nths
-        locnaggr(i) = locnaggr(i) + locnaggr(i-1)
-      end do
-      do i=nths+1,1,-1
-        locnaggr(i) = locnaggr(i-1)
-      end do
-      locnaggr(0) = 0
-      !$omp end master 
-      !$omp barrier
-      !$omp  do schedule(static) 
-      do kk=0, nths-1
-        do ii=bnds(kk), bnds(kk+1)-1
-          if (ilaggr(ii) > 0) then 
-            kp = mod(ilaggr(ii),nths)
-            ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
-          end if
-        end do
-      end do
-      !$omp end do
-    end block
-    !$omp end parallel
-  end block
-  if (info /= 0) then
-    if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
-    info=psb_err_internal_error_
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-#else
+  icnt = 0
   step1: do ii=1, nr
-    if (info /= 0) cycle
     i = idxs(ii)
     if ((i<1).or.(i>nr)) then
       info=psb_err_internal_error_
       call psb_errpush(info,name)
-      cycle step1
-      !goto 9999
+      goto 9999
     end if
-
+    
     if (ilaggr(i) == -(nr+1)) then
       nz         = (acsr%irp(i+1)-acsr%irp(i))
       if ((nz<0).or.(nz>size(icol))) then
         info=psb_err_internal_error_
         call psb_errpush(info,name)
-        cycle step1
-        !goto 9999
+        goto 9999
       end if
 
       icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
@@ -353,11 +176,11 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       !
       ! Build the set of all strongly coupled nodes 
       !
-      ip = 0
+      ip = 0 
       do k=1, nz
         j   = icol(k)
         if ((1<=j).and.(j<=nr)) then 
-          if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.czero)) then
+          if (abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))) then
             ip = ip + 1
             icol(ip) = icol(k)
           end if
@@ -371,7 +194,8 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       ! contains I even if it does not look like it from matrix)
       !
       disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
-      if (disjoint) then       
+      if (disjoint) then 
+        icnt      = icnt + 1 
         naggr     = naggr + 1
         do k=1, ip
           ilaggr(icol(k)) = naggr
@@ -380,22 +204,16 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     endif
   enddo step1
-#endif
+  
   if (debug_level >= psb_debug_outer_) then 
     write(debug_unit,*) me,' ',trim(name),&
-         & ' Check   1:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
-         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
+         & ' Check 1:',count(ilaggr == -(nr+1))
   end if
-  if (do_timings) call psb_toc(idx_soc1_p1)
-  if (do_timings) call psb_tic(idx_soc1_p2)
+
   !
   ! Phase two: join the neighbours
   !
-  !$omp workshare
   tmpaggr = ilaggr
-  !$omp end workshare
-  !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,theta)& 
-  !$omp     private(ii,i,j,k,nz,icol,val,ip,cpling)
   step2: do ii=1,nr
     i = idxs(ii)
 
@@ -426,15 +244,8 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     end if
   end do step2
-  !$omp end parallel do
-  if (do_timings) call psb_toc(idx_soc1_p2)
-  if (debug_level >= psb_debug_outer_) then 
-    write(debug_unit,*) me,' ',trim(name),&
-         & ' Check 1.5:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
-         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
-  end if
 
-  if (do_timings) call psb_tic(idx_soc1_p3)
+
   !
   ! Phase three: sweep over leftovers, if any 
   !
@@ -463,6 +274,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         end if
       enddo
       if (ip > 0) then
+        icnt      = icnt + 1 
         naggr     = naggr + 1
         ilaggr(i) = naggr
         do k=1, ip
@@ -480,10 +292,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   end do step3
 
   ! Any leftovers?
-  !$omp parallel do schedule(static) shared(ilaggr,info)& 
-  !$omp     private(ii,i,j,k,nz,icol,val,ip)
   do i=1, nr
-    if (info /= 0) cycle
     if (ilaggr(i) < 0) then
       nz = (acsr%irp(i+1)-acsr%irp(i))
       if (nz == 1) then
@@ -494,18 +303,15 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         ! other processes. 
         ilaggr(i) = -(nrglob+nr)
       else
-        !$omp atomic write
         info=psb_err_internal_error_
-        !$omp end atomic
         call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
-        cycle 
+        goto 9999
       endif
     end if
   end do
-  !$omp end parallel do
-  if (info /= 0) goto 9999
-  if (do_timings) call psb_toc(idx_soc1_p3)
+
   if (naggr > ncol) then 
+    !write(0,*) name,'Error : naggr > ncol',naggr,ncol
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')
     goto 9999
@@ -530,13 +336,9 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nlaggr(:) = 0
   nlaggr(me+1) = naggr
   call psb_sum(ctxt,nlaggr(1:np))
-  if (debug_level >= psb_debug_outer_) then 
-    write(debug_unit,*) me,' ',trim(name),&
-         & ' Check   2:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
-         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
-  end if
 
   call acsr%free()
+
   call psb_erractionrestore(err_act)
   return
 
@@ -545,3 +347,4 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   return
 
 end subroutine amg_c_soc1_map_bld
+

amgprec/impl/aggregator/amg_c_soc2_map_bld.f90

@@ -68,12 +68,9 @@
 !
 subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
 
-  use psb_base_mod 
+  use psb_base_mod
   use amg_base_prec_type
   use amg_c_inner_mod
-#if defined(OPENMP)
-  use omp_lib
-#endif
 
   implicit none
 
@@ -102,9 +99,6 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_) :: np, me
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
-  integer(psb_ipk_), save :: idx_soc2_p1=-1, idx_soc2_p2=-1, idx_soc2_p3=-1
-  integer(psb_ipk_), save :: idx_soc2_p0=-1
-  logical, parameter      :: do_timings=.true.
 
   info=psb_success_
   name = 'amg_soc2_map_bld'
@@ -120,14 +114,6 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nrow   = desc_a%get_local_rows()
   ncol   = desc_a%get_local_cols()
   nrglob = desc_a%get_global_rows()
-  if ((do_timings).and.(idx_soc2_p0==-1))       &
-       & idx_soc2_p0 = psb_get_timer_idx("SOC2_MAP: phase0")
-  if ((do_timings).and.(idx_soc2_p1==-1))       &
-       & idx_soc2_p1 = psb_get_timer_idx("SOC2_MAP: phase1")
-  if ((do_timings).and.(idx_soc2_p2==-1))       &
-       & idx_soc2_p2 = psb_get_timer_idx("SOC2_MAP: phase2")
-  if ((do_timings).and.(idx_soc2_p3==-1))       &
-       & idx_soc2_p3 = psb_get_timer_idx("SOC2_MAP: phase3")
 
   nr = a%get_nrows()
   nc = a%get_ncols()
@@ -139,7 +125,6 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
     goto 9999
   end if
 
-  if (do_timings) call psb_tic(idx_soc2_p0)
   diag = a%get_diag(info)
   if(info /= psb_success_) then
     info=psb_err_from_subroutine_
@@ -152,218 +137,55 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   ! 
   call a%cp_to(muij)
   if (clean_zeros) call muij%clean_zeros(info)
-  !$omp parallel do private(i,j,k) shared(nr,diag,muij) schedule(static)
   do i=1, nr
     do k=muij%irp(i),muij%irp(i+1)-1
       j = muij%ja(k)
       if (j<= nr) muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
     end do
   end do
-  !$omp end parallel do 
+
   !
   ! Compute the 1-neigbour; mark strong links with +1, weak links with -1
   !
   call s_neigh_coo%allocate(nr,nr,muij%get_nzeros())
-  !$omp parallel do private(i,j,k) shared(nr,diag,muij) schedule(static)
+  ip = 0 
   do i=1, nr
     do k=muij%irp(i),muij%irp(i+1)-1
       j = muij%ja(k)
-      s_neigh_coo%ia(k)  = i
-      s_neigh_coo%ja(k)  = j
       if (j<=nr) then 
+        ip = ip + 1
+        s_neigh_coo%ia(ip)  = i
+        s_neigh_coo%ja(ip)  = j
         if (real(muij%val(k)) >= theta) then 
-          s_neigh_coo%val(k) = sone
+          s_neigh_coo%val(ip) = sone
         else
-          s_neigh_coo%val(k) = -sone
+          s_neigh_coo%val(ip) = -sone
         end if
-      else
-        s_neigh_coo%val(k) = -sone        
       end if
     end do
   end do
-  !$omp end parallel do
   !write(*,*) 'S_NEIGH: ',nr,ip
-  call s_neigh_coo%set_nzeros(muij%get_nzeros())
+  call s_neigh_coo%set_nzeros(ip)
   call s_neigh%mv_from_coo(s_neigh_coo,info)
 
-  if (iorder == amg_aggr_ord_nat_) then
-    
-    !$omp parallel do private(i) shared(ilaggr,idxs) schedule(static)
+  if (iorder == amg_aggr_ord_nat_) then 
     do i=1, nr
       ilaggr(i) = -(nr+1)
       idxs(i)   = i 
     end do
-    !$omp end parallel do 
   else 
-    !$omp parallel do private(i) shared(ilaggr,idxs,muij)  schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
       ideg(i)   = muij%irp(i+1) - muij%irp(i)
     end do
-    !$omp end parallel do
     call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
   end if
 
-  if (do_timings) call psb_toc(idx_soc2_p0)
-  if (do_timings) call psb_tic(idx_soc2_p1)
 
   !
   ! Phase one: Start with disjoint groups.
   ! 
   naggr = 0
-#if defined(OPENMP)
-  block
-    integer(psb_ipk_), allocatable  :: bnds(:), locnaggr(:)
-    integer(psb_ipk_) :: myth,nths, kk
-    ! The parallelization makes use of a locaggr(:) array; each thread
-    ! keeps its own version of naggr, and when the loop ends, a prefix is applied
-    ! to locnaggr to determine:
-    ! 1. The total number of aggregaters NAGGR;
-    ! 2. How much should each thread shift its own aggregates
-    ! Part 2 requires to keep track of which thread defined each entry
-    ! of ilaggr(), so that each entry can be adjusted correctly: even
-    ! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
-    ! been set because it is strongly connected to an entry J belonging to a
-    ! different thread. 
-
-    !$omp parallel shared(s_neigh,bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
-    !$omp private(icol,val,myth,kk) 
-    block
-      integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz,nc,i,j,m,nz,ilg,ip,rsz,ip1,nzcnt
-      integer(psb_lpk_) :: itmp
-      !$omp master
-      nths = omp_get_num_threads()
-      allocate(bnds(0:nths),locnaggr(0:nths+1))
-      locnaggr(:) = 0
-      bnds(0) = 1
-      !$omp end master      
-      !$omp barrier
-      myth = omp_get_thread_num()
-      rsz = nr/nths
-      if (myth < mod(nr,nths)) rsz = rsz + 1
-      bnds(myth+1) = rsz
-      !$omp barrier
-      !$omp master
-      do i=1,nths
-        bnds(i) = bnds(i) + bnds(i-1)
-      end do
-      info = 0
-      !$omp end master
-      !$omp barrier
-
-      !$omp do schedule(static) private(disjoint) 
-      do kk=0, nths-1
-        step1: do ii=bnds(kk), bnds(kk+1)-1
-          i = idxs(ii)
-          if (info /= 0) then
-            write(0,*) ' Step1:',kk,ii,i,info
-            cycle step1
-          end if
-          if ((i<1).or.(i>nr)) then
-            !$omp atomic write
-            info=psb_err_internal_error_
-            !$omp end atomic 
-            call psb_errpush(info,name)
-            cycle step1
-            !goto 9999
-          end if
-
-
-          if (ilaggr(i) == -(nr+1)) then 
-            !
-            ! Get the 1-neighbourhood of I 
-            !
-            ip1 = s_neigh%irp(i)
-            nz  = s_neigh%irp(i+1)-ip1
-            !
-            ! If the neighbourhood only contains I, skip it
-            !
-            if (nz ==0) then
-              ilaggr(i) = 0
-              cycle step1
-            end if
-            if ((nz==1).and.(s_neigh%ja(ip1)==i)) then
-              ilaggr(i) = 0
-              cycle step1
-            end if
-
-            nzcnt = count(real(s_neigh%val(ip1:ip1+nz-1)) > 0)
-            icol(1:nzcnt) = pack(s_neigh%ja(ip1:ip1+nz-1),(real(s_neigh%val(ip1:ip1+nz-1)) > 0))
-            disjoint = all(ilaggr(icol(1:nzcnt)) == -(nr+1)) 
-
-            !
-            ! If the whole strongly coupled neighborhood of I is
-            ! as yet unconnected, turn it into the next aggregate.
-            ! Same if ip==0 (in which case, neighborhood only
-            ! contains I even if it does not look like it from matrix)
-            ! The fact that DISJOINT is private and not under lock
-            ! generates a certain un-repeatability, in that between
-            ! computing DISJOINT and assigning, another thread might
-            ! alter the values of ILAGGR.
-            ! However, a certain unrepeatability is already present
-            ! because the sequence of aggregates is computed with a
-            ! different order than in serial mode.
-            ! In any case, even if the enteries of ILAGGR may be
-            ! overwritten, the important thing is that each entry is
-            ! consistent and they generate a correct aggregation map.
-            !
-            if (disjoint) then
-              locnaggr(kk)     = locnaggr(kk) + 1
-              itmp = (bnds(kk)-1+locnaggr(kk)) !be careful about overflow
-              itmp = itmp*nths+kk
-              if (itmp < (bnds(kk)-1+locnaggr(kk))) then
-                !$omp atomic update
-                info = max(12345678,info)
-                !$omp end atomic
-                cycle step1
-              end if
-              !$omp atomic write
-              ilaggr(i) = itmp
-              !$omp end atomic
-              do k=1, nzcnt
-                !$omp atomic write
-                ilaggr(icol(k)) = itmp
-                !$omp end atomic
-              end do
-            end if
-          end if
-        enddo step1
-      end do
-      !$omp end do
-
-      !$omp master
-      naggr = sum(locnaggr(0:nths-1))
-      do i=1,nths
-        locnaggr(i) = locnaggr(i) + locnaggr(i-1)
-      end do
-      do i=nths+1,1,-1
-        locnaggr(i) = locnaggr(i-1)
-      end do
-      locnaggr(0) = 0
-      !write(0,*) 'LNAG ',locnaggr(nths+1)
-      !$omp end master 
-      !$omp barrier
-      !$omp  do schedule(static) 
-      do kk=0, nths-1
-        do ii=bnds(kk), bnds(kk+1)-1
-          if (ilaggr(ii) > 0) then 
-            kp = mod(ilaggr(ii),nths)
-            ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
-          end if
-        end do
-      end do
-      !$omp end do
-    end block
-    !$omp end parallel
-  end block
-  if (info /= 0) then
-    if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
-    info=psb_err_internal_error_
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-
-#else
   icnt = 0
   step1: do ii=1, nr
     i = idxs(ii)
@@ -402,21 +224,16 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     endif
   enddo step1
-#endif  
+  
   if (debug_level >= psb_debug_outer_) then 
     write(debug_unit,*) me,' ',trim(name),&
          & ' Check 1:',count(ilaggr == -(nr+1))
   end if
-  if (do_timings) call psb_toc(idx_soc2_p1)
-  if (do_timings) call psb_tic(idx_soc2_p2)
+
   !
   ! Phase two: join the neighbours
   !
-  !$omp workshare
   tmpaggr = ilaggr
-  !$omp end workshare
-  !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,muij,s_neigh)& 
-  !$omp     private(ii,i,j,k,nz,icol,val,ip,cpling)
   step2: do ii=1,nr
     i = idxs(ii)
 
@@ -442,9 +259,8 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     end if
   end do step2
-  !$omp end parallel do
-  if (do_timings) call psb_toc(idx_soc2_p2)
-  if (do_timings) call psb_tic(idx_soc2_p3)
+
+
   !
   ! Phase three: sweep over leftovers, if any 
   !
@@ -478,8 +294,6 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   end do step3
 
   ! Any leftovers?
-  !$omp parallel do schedule(static) shared(ilaggr,s_neigh,info)& 
-  !$omp     private(ii,i,j,k)
   do i=1, nr
     if (ilaggr(i) <= 0) then
       nz = (s_neigh%irp(i+1)-s_neigh%irp(i))
@@ -491,17 +305,13 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         ! other processes. 
         ilaggr(i) = -(nrglob+nr)
       else
-        !$omp atomic write
         info=psb_err_internal_error_
-        !$omp end atomic
         call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
-        cycle
+        goto 9999
       endif
     end if
   end do
-  !$omp end parallel do
-  if (info /= 0) goto 9999
-  if (do_timings) call psb_toc(idx_soc2_p3)  
+
   if (naggr > ncol) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')

amgprec/impl/aggregator/amg_caggrmat_minnrg_bld.f90

@@ -69,7 +69,6 @@
 !
 !
 ! Arguments:
-!    dol1smoothing - fictitious integer argument, it is not used inside
 !    a          -  type(psb_cspmat_type), input.     
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -105,8 +104,8 @@
 !                  Error code.
 !
 !
-subroutine amg_caggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_caggrmat_minnrg_bld(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, amg_protect_name => amg_caggrmat_minnrg_bld
@@ -114,7 +113,6 @@ subroutine amg_caggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)                 :: dol1smoothing
   type(psb_cspmat_type), intent(in)           :: a
   type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
@@ -173,13 +171,6 @@ subroutine amg_caggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 
   filter_mat = (parms%aggr_filter == amg_filter_mat_)
 
-  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
-
-
   !NEEDS TO BE REWORKED !!
   
   ! naggr: number of local aggregates
@@ -309,7 +300,7 @@ subroutine amg_caggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 !!$        endif
 !!$      enddo
 !!$      if (jd == -1) then 
-!!$                write(0,*) name,': Warning: there is no diagonal element', i
+!!$        write(0,*) 'Wrong input: we need the diagonal!!!!', i
 !!$      else
 !!$        acsrf%val(jd)=acsrf%val(jd)-tmp
 !!$      end if

amgprec/impl/aggregator/amg_caggrmat_nosmth_bld.f90

@@ -94,11 +94,10 @@
 !               
 !    info       -  integer, output.
 !                  Error code.
-!    dol1smoothing - optional, this is here just for interfacing reasons. It is not used by the
-!                    code
 !
-subroutine amg_caggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+!
+subroutine amg_caggrmat_nosmth_bld(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, amg_protect_name => amg_caggrmat_nosmth_bld
@@ -106,7 +105,6 @@ subroutine amg_caggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)              :: dol1smoothing 
   type(psb_cspmat_type), intent(in)        :: a
   type(psb_desc_type), intent(inout)         :: desc_a
   integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
@@ -139,12 +137,6 @@ subroutine amg_caggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 
   ctxt = desc_a%get_context()
   call psb_info(ctxt, 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()

amgprec/impl/aggregator/amg_caggrmat_smth_bld.f90

@@ -69,8 +69,6 @@
 !
 !
 ! Arguments:
-!    dol1smooth -  Integer taking the type of smoother that has to be used
-!                  on the tentative prolongator
 !    a          -  type(psb_cspmat_type), input.     
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -104,8 +102,8 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_caggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_caggrmat_smth_bld(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, amg_protect_name => amg_caggrmat_smth_bld
@@ -114,7 +112,6 @@ subroutine amg_caggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)            :: dol1smoothing
   type(psb_cspmat_type), intent(in)      :: a
   type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
@@ -135,7 +132,7 @@ subroutine amg_caggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   type(psb_c_coo_sparse_mat) :: coo_prol, coo_restr
   type(psb_c_csr_sparse_mat) :: acsr1,  acsrf, csr_prol, acsr
   complex(psb_spk_), allocatable :: adiag(:)
-  real(psb_spk_), allocatable :: arwsum(:),l1rwsum(:)
+  real(psb_spk_), allocatable :: arwsum(:)
   integer(psb_ipk_)  :: ierr(5)
   logical            :: filter_mat
   integer(psb_ipk_)            :: debug_level, debug_unit, err_act
@@ -144,7 +141,6 @@ subroutine amg_caggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   logical, parameter :: debug_new=.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
   integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1
 
@@ -177,9 +173,6 @@ subroutine amg_caggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   if ((do_timings).and.(idx_ptap==-1)) &
        & idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld  ")
 
-  ! check if we have to use Jacobi or l1-Jacobi to smooth the tentative prolongator
-  if (dol1smoothing.eq.amg_l1_smooth_prol_) do_l1correction=.true.
-
 
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
@@ -207,24 +200,6 @@ subroutine amg_caggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
   if (info == psb_success_) call a%cp_to(acsr)
-  !
-  ! Do the l1-correction on the diagonal if it is requested
-  !
-  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}|
-    !$OMP parallel do private(i) schedule(static)
-    do i=1,size(adiag)
-      adiag(i) = adiag(i) + l1rwsum(i) - abs(adiag(i))
-    end do
-    !$OMP end parallel do
-  end if
-
 
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
@@ -255,7 +230,6 @@ subroutine amg_caggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 
       enddo
       if (jd == -1) then 
-        ! if (.not.do_l1correction) 
         write(0,*) 'Wrong input: we need the diagonal!!!!', i
       else
         acsrf%val(jd)=acsrf%val(jd)-tmp
@@ -278,10 +252,6 @@ subroutine amg_caggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   !$OMP end parallel do 
   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
-    !
     if (parms%aggr_eig == amg_max_norm_) then 
       allocate(arwsum(nrow))
       call acsr%arwsum(arwsum)      
@@ -289,6 +259,7 @@ subroutine amg_caggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
       call psb_amx(ctxt,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_')
@@ -351,7 +322,6 @@ subroutine amg_caggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '
-  if (allocated(l1rwsum)) deallocate(l1rwsum)
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_d_dec_aggregator_mat_bld.f90

@@ -177,24 +177,23 @@ subroutine  amg_d_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   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(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_) 
 
-    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(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)
+    call amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, &
+         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
   case default
     info = psb_err_internal_error_

amgprec/impl/aggregator/amg_d_newmatch_aggregator_inner_mat_asb.F90

@@ -0,0 +1,166 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!
+!    (C) Copyright 2021
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+! File: amg_d_newmatch_aggregator_mat_asb.f90
+!
+! Subroutine: amg_d_newmatch_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_d_newmatch_aggregator_type), input/output.
+!               The aggregator object
+!    parms   -  type(amg_dml_parms), input
+!               The aggregation parameters
+!    a          -  type(psb_dspmat_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_dspmat_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_dspmat_type), input/output
+!                  The tentative prolongator on input, the computed prolongator on output
+!
+!    op_restr    -  type(psb_dspmat_type), input/output
+!                  The restrictor operator; normally, it is the transpose of the prolongator.
+!
+!    info       -  integer, output.
+!                  Error code.
+!
+subroutine  amg_d_newmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
+     & ac,desc_ac, op_prol,op_restr,info)
+  use psb_base_mod
+  use amg_base_prec_type
+#if defined(SERIAL_MPI)
+  use amg_d_newmatch_aggregator_mod
+#else
+  use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_inner_mat_asb
+#endif
+  implicit none
+  class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
+  type(amg_dml_parms), intent(inout)    :: parms
+  type(psb_dspmat_type), intent(in)     :: a
+  type(psb_desc_type), intent(in)       :: desc_a
+  type(psb_dspmat_type), intent(inout) :: op_prol,op_restr
+  type(psb_dspmat_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_ld_coo_sparse_mat) :: acoo, bcoo
+  type(psb_ld_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_newmatch_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 !defined(SERIAL_MPI)
+
+  if (debug) write(0,*) me,' ',trim(name),' Start:',&
+       & allocated(ag%ac),allocated(ag%desc_ac), allocated(ag%prol),allocated(ag%restr)
+
+  select case(parms%coarse_mat)
+
+  case(amg_distr_mat_)
+    ! Do nothing, it has already been done in spmm_bld_ov.
+
+  case(amg_repl_mat_)
+    !
+    !
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,a_err='no repl coarse_mat_ here')
+    goto 9999
+
+  case default
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,a_err='invalid amg_coarse_mat_')
+    goto 9999
+  end select
+#endif
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+
+
+end subroutine amg_d_newmatch_aggregator_inner_mat_asb

amgprec/impl/aggregator/amg_d_newmatch_aggregator_mat_asb.f90

@@ -0,0 +1,150 @@
+!   
+!  
+! File: amg_d_newmatch_aggregator_mat_asb.f90
+!
+! Subroutine: amg_d_newmatch_aggregator_mat_asb
+! Version:    real
+!
+!
+!  From a given AC to final format, generating DESC_AC
+! 
+! Arguments:
+!    ag       -  type(amg_d_newmatch_aggregator_type), input/output.
+!               The aggregator object
+!    parms   -  type(amg_dml_parms), input 
+!               The aggregation parameters
+!    a          -  type(psb_dspmat_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_dspmat_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_dspmat_type), input/output
+!                  The tentative prolongator on input, the computed prolongator on output
+!               
+!    op_restr    -  type(psb_dspmat_type), input/output
+!                  The restrictor operator; normally, it is the transpose of the prolongator. 
+!               
+!    info       -  integer, output.
+!                  Error code.
+!  
+subroutine  amg_d_newmatch_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_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_mat_asb
+  implicit none
+  class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
+  type(amg_dml_parms), intent(inout)    :: parms 
+  type(psb_dspmat_type), intent(in)     :: a
+  type(psb_desc_type), intent(inout)    :: desc_a
+  type(psb_dspmat_type), intent(inout) :: op_prol, ac,op_restr
+  type(psb_desc_type), intent(inout)    :: desc_ac
+  integer(psb_ipk_), intent(out)        :: info
+  !
+  type(psb_ctxt_type)         :: ctxt
+  integer(psb_ipk_)           :: np, me
+  type(psb_ld_coo_sparse_mat) :: tmpcoo
+  type(psb_ldspmat_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_newmatch_aggregator_mat_asb'
+
+
+  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_
+  ctxt = desc_a%get_context()
+  call psb_info(ctxt,me,np)
+
+  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 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 op_restr%mv_from(tmpcoo)
+
+    call op_prol%set_ncols(i_nr)
+    call op_restr%set_nrows(i_nr)
+
+    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_d_newmatch_aggregator_mat_asb

amgprec/impl/aggregator/amg_d_newmatch_aggregator_mat_bld.f90

@@ -0,0 +1,183 @@
+!   
+!  
+! File: amg_d_base_aggregator_mat_bld.f90
+!
+! Subroutine: amg_d_base_aggregator_mat_bld
+! Version:    real
+!
+!  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_dprecinit 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_d_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 MLD2P4.
+!     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_d_base_aggregator_type), input/output.
+!               The aggregator object
+!    parms   -  type(amg_dml_parms), input 
+!               The aggregation parameters
+!    a          -  type(psb_dspmat_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_dspmat_type), output
+!                  The coarse matrix on output 
+!                  
+!    op_prol    -  type(psb_dspmat_type), input/output
+!                  The tentative prolongator on input, the computed prolongator on output
+!               
+!    op_restr    -  type(psb_dspmat_type), output
+!                  The restrictor operator; normally, it is the transpose of the prolongator. 
+!               
+!    info       -  integer, output.
+!                  Error code.
+!  
+subroutine  amg_d_newmatch_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_d_inner_mod
+  use amg_d_prec_type, amg_protect_name => amg_d_newmatch_aggregator_mat_bld
+  !use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_mat_bld
+  implicit none
+  
+  class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
+  type(amg_dml_parms), intent(inout)    :: parms 
+  type(psb_dspmat_type), intent(in)     :: a
+  type(psb_desc_type), intent(inout)    :: desc_a
+  integer(psb_lpk_), intent(inout)      :: ilaggr(:), nlaggr(:)
+  type(psb_ldspmat_type), intent(inout) :: t_prol
+  type(psb_dspmat_type), intent(inout)  :: op_prol,ac,op_restr
+  type(psb_desc_type), intent(inout)    :: desc_ac
+  integer(psb_ipk_), intent(out)        :: info
+
+  ! Local variables
+  character(len=20)           :: name
+  type(psb_ctxt_type)         :: ctxt
+  integer(psb_mpk_)           :: np, me
+  type(psb_ld_coo_sparse_mat) :: acoo, bcoo
+  type(psb_ld_csr_sparse_mat) :: acsr1
+  integer(psb_lpk_)           :: nzl,ntaggr
+  integer(psb_ipk_)           :: err_act
+  integer(psb_ipk_)           :: debug_level, debug_unit
+
+  name='amg_d_newmatch_aggregator_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_
+  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_) 
+
+!!$    call amg_d_newmatch_unsmth_spmm_bld(a,desc_a,ilaggr,nlaggr,&
+!!$         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr, &
+         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+
+
+  case(amg_smooth_prol_) 
+
+    call amg_daggrmat_smth_bld(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,info)
+
+  case(amg_min_energy_) 
+
+    call amg_daggrmat_minnrg_bld(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 bld')
+    goto 9999
+  end if
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+
+  
+end subroutine amg_d_newmatch_aggregator_mat_bld

amgprec/impl/aggregator/amg_d_newmatch_aggregator_tprol.F90

@@ -0,0 +1,448 @@
+!   
+!  
+! File: amg_d_newmatch_aggregator_tprol.f90
+!
+! Subroutine: amg_d_newmatch_aggregator_tprol
+! Version:    real
+!
+!
+
+subroutine  amg_d_newmatch_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_d_inner_mod
+  use amg_d_decmatch_mod
+#if defined(SERIAL_MPI)
+    use amg_d_newmatch_aggregator_mod
+#else
+  use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_build_tprol
+#endif
+  use iso_c_binding
+  implicit none
+  class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
+  type(amg_dml_parms), intent(inout)   :: parms
+  type(amg_daggr_data), intent(in)     :: ag_data
+  type(psb_dspmat_type), intent(inout) :: a
+  type(psb_desc_type), intent(inout)      :: desc_a
+  integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
+  type(psb_ldspmat_type), intent(out)  :: t_prol
+  integer(psb_ipk_), intent(out)      :: info
+
+
+  ! Local variables
+  real(psb_dpk_), allocatable    :: tmpw(:), tmpwnxt(:)
+  integer(psb_lpk_), allocatable :: ixaggr(:), nxaggr(:), tlaggr(:), ivr(:)
+  type(psb_dspmat_type)          :: a_tmp
+  type(nwm_CSRMatrix) :: C, P
+  integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels
+  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_d_csr_sparse_mat), target  :: csr_prol, csr_pvi, csr_prod_res, acsr
+  type(psb_ld_csr_sparse_mat), target :: lcsr_prol
+  type(psb_desc_type), allocatable    :: desc_acv(:)
+  type(psb_ld_coo_sparse_mat)         :: tmpcoo, transp_coo
+  type(psb_dspmat_type), allocatable  :: acv(:)
+  type(psb_dspmat_type), allocatable  :: prolv(:), restrv(:)
+  type(psb_ldspmat_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=.true., debug=.false., &
+       & dump_prol_restr=.false.
+  name='d_newmatch_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_decoupled_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',dzero,is_legal_d_aggr_thrs)
+
+#if !defined(SERIAL_MPI)
+
+  match_algorithm = ag%matching_alg
+  n_sweeps        = ag%n_sweeps
+  if (2**n_sweeps /= ag%orig_aggr_size) then
+    if (me == 0) then
+      write(debug_unit, *) 'Warning: AGGR_SIZE reset to value ',2**n_sweeps
+    end if
+  end if
+  if (ag%max_csize > 0) then
+    max_csize       = ag%max_csize
+  else
+    max_csize       = ag_data%min_coarse_size
+  end if
+  if (ag%max_nlevels > 0) then
+    max_nlevels     = ag%max_nlevels
+  else
+    max_nlevels = ag_data%max_levs
+  end if
+  if (.true.) then
+    block
+      integer(psb_ipk_) :: ipv(2)
+      ipv(1) = max_csize
+      ipv(2) = n_sweeps
+      call psb_bcast(ictxt,ipv)
+      max_csize = ipv(1)
+      n_sweeps  = ipv(2)
+    end block
+  else
+    call psb_bcast(ictxt,max_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
+  n_sweeps = max(1,n_sweeps)
+
+  if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,max_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_ldspmat_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(),max_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_ddecmatch_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,&
+         & symmetrize=ag%need_symmetrize,reproducible=ag%reproducible_matching,&
+         & parallel=ag%parallel_matching,matching=ag%matching_alg,lambda=ag%lambda)
+    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_d_newmatch_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),max_csize,info
+      csz = sum(nxaggr)
+      call psb_bcast(ictxt,csz)
+      if (csz /= sum(nxaggr)) write(0,*) me,trim(name),' Mismatch matasb',&
+           & csz,sum(nxaggr),max_csize
+    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(done,restrv(1),tmpw,dzero,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),max_csize, info
+    end if
+    call acv(i-1)%free()
+    if ((sum(nlaggr) <= max_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
+#endif
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
+
+end subroutine amg_d_newmatch_aggregator_build_tprol
+  

amgprec/impl/aggregator/amg_d_newmatch_map_to_tprol.f90

@@ -0,0 +1,128 @@
+!   
+!  
+! File: amg_d_newmatch_map_to_tprol.f90
+!
+! Subroutine: amg_d_newmatch_map_to_tprol
+! Version:    real
+!
+!  This routine uses a mapping from the row indices of the fine-level matrix
+!  to the row indices of the coarse-level matrix to build a tentative
+!  prolongator, i.e. a piecewise constant operator.
+!  This is later used to build the final operator; the code has been refactored here
+!  to  be shared among all the methods that provide the tentative prolongator
+!  through a simple integer mapping.
+!
+!  The aggregation algorithm is a parallel version of that described in
+!  * M. Brezina and P. Vanek, A black-box iterative solver based on a 
+!    two-level Schwarz method, Computing,  63 (1999), 233-263.
+!  * P. Vanek, J. Mandel and M. Brezina, Algebraic Multigrid by Smoothed
+!    Aggregation for Second and Fourth Order Elliptic Problems, Computing, 56
+!    (1996), 179-196.
+!  For more 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:
+!    aggr_type  -  integer, input.
+!                  The scalar used to identify the aggregation algorithm.
+!    theta      -  real, input.
+!                  The aggregation threshold used in the aggregation algorithm.
+!    a          -  type(psb_dspmat_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.
+!    ilaggr     -  integer, dimension(:), allocatable.
+!                  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 on exit the indices
+!                  will be shifted so as to make sure the ranges on the various processes do not
+!                  overlap.
+!    nlaggr     -  integer, dimension(:), allocatable.
+!                  nlaggr(i) contains the aggregates held by process i.
+!    op_prol    -  type(psb_dspmat_type).
+!               The tentative prolongator, based on ilaggr.
+!               
+!    info       -  integer, output.
+!                  Error code.
+!
+subroutine amg_d_newmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr, op_prol,info)
+
+  use psb_base_mod
+  use amg_d_inner_mod!, amg_protect_name => amg_d_newmatch_map_to_tprol
+  use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_map_to_tprol
+
+  implicit none
+
+  ! Arguments
+  type(psb_desc_type), intent(in)    :: desc_a
+  integer(psb_lpk_), allocatable, intent(inout)  :: ilaggr(:),nlaggr(:)
+  real(psb_dpk_), allocatable, intent(inout)  :: valaggr(:)
+  type(psb_ldspmat_type), intent(out)  :: op_prol
+  integer(psb_ipk_), intent(out)               :: info
+
+  ! Local variables
+  integer(psb_lpk_)   :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr
+  type(psb_ld_coo_sparse_mat) :: tmpcoo
+  integer(psb_ipk_)   :: debug_level, debug_unit,err_act
+  type(psb_ctxt_type) :: ctxt
+  integer(psb_ipk_)   :: np, me
+  integer(psb_lpk_)   :: nrow, ncol, n_ne
+  character(len=20)   :: name, ch_err
+
+  if(psb_get_errstatus() /= 0) return 
+  info=psb_success_
+  name = 'amg_d_newmatch_map_to_tprol'
+  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)
+  nrow  = desc_a%get_local_rows()
+  ncol  = desc_a%get_local_cols()
+
+  naggr   = nlaggr(me+1)
+  ntaggr  = sum(nlaggr)
+  naggrm1 = sum(nlaggr(1:me))
+  naggrp1 = sum(nlaggr(1:me+1))
+  ilaggr(1:nrow) = ilaggr(1:nrow) + naggrm1
+  call psb_halo(ilaggr,desc_a,info)
+  if (info /= psb_success_) then
+    call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_halo')
+    goto 9999
+  end if
+
+  call psb_halo(valaggr,desc_a,info)
+  if (info /= psb_success_) then
+    call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_halo')
+    goto 9999
+  end if
+
+  call tmpcoo%allocate(ncol,ntaggr,ncol)
+  j = 0
+  do i=1,ncol
+    if (valaggr(i) /= dzero) then
+      j = j + 1
+      tmpcoo%val(j) = valaggr(i)
+      tmpcoo%ia(j)  = i
+      tmpcoo%ja(j)  = ilaggr(i)
+    end if
+  end do
+  call tmpcoo%set_nzeros(j)
+  call tmpcoo%set_dupl(psb_dupl_add_)
+  call tmpcoo%set_sorted() ! At this point this is in row-major
+  call op_prol%mv_from(tmpcoo)
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+
+end subroutine amg_d_newmatch_map_to_tprol

amgprec/impl/aggregator/amg_d_newmatch_spmm_bld_inner.F90

@@ -0,0 +1,218 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!
+!    (C) Copyright 2021
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+! File: amg_daggrmat_nosmth_bld.F90
+!
+! Subroutine: amg_daggrmat_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_dprecinit 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_dspmat_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_d_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_dml_parms), input
+!                  Parameters controlling the choice of algorithm
+!    ac         -  type(psb_dspmat_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_dspmat_type), input/output
+!                  The tentative prolongator on input, the computed prolongator on output
+!
+!    op_restr    -  type(psb_dspmat_type), output
+!                  The restrictor operator; normally, it is the transpose of the prolongator.
+!
+!    info       -  integer, output.
+!                  Error code.
+!
+!
+subroutine amg_d_newmatch_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,&
+     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+  use psb_base_mod
+  use amg_d_inner_mod
+#if defined(SERIAL_MPI)
+    use amg_d_newmatch_aggregator_mod
+#else
+  use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_spmm_bld_inner
+#endif
+  implicit none
+
+  ! Arguments
+  type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
+  type(psb_desc_type), intent(inout)          :: desc_a
+  integer(psb_lpk_), intent(inout)          :: ilaggr(:), nlaggr(:)
+  type(amg_dml_parms), intent(inout)        :: parms
+  type(psb_ldspmat_type), intent(inout)     :: t_prol
+  type(psb_dspmat_type), intent(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_ld_coo_sparse_mat) :: tmpcoo
+  type(psb_d_coo_sparse_mat)  :: coo_prol, coo_restr
+  type(psb_d_csr_sparse_mat)  :: ac_csr, csr_restr
+  type(psb_desc_type), target  :: tmp_desc
+  type(psb_ldspmat_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=.true., oldstyle=.false., debug=.false.
+  integer(psb_ipk_), save :: idx_spspmm=-1, idx_prolcnv=-1, idx_proltrans=-1, idx_asb=-1
+
+  name='amg_newmatch_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))
+
+#if !defined(SERIAL_MPI)
+  !
+  ! 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 '
+#endif
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+
+end subroutine amg_d_newmatch_spmm_bld_inner

amgprec/impl/aggregator/amg_d_newmatch_spmm_bld_ov.F90

@@ -0,0 +1,169 @@
+!
+!
+!                             AMG4PSBLAS version 1.0
+!    Algebraic Multigrid Package
+!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
+!
+!    (C) Copyright 2021
+!
+!        Salvatore Filippone
+!        Pasqua D'Ambra
+!        Fabio Durastante
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the AMG4PSBLAS group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+! File: amg_daggrmat_nosmth_bld_ov.F90
+!
+! Subroutine: amg_daggrmat_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_dprecinit 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_dspmat_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_d_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_dml_parms), input
+!                  Parameters controlling the choice of algorithm
+!    ac         -  type(psb_dspmat_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_dspmat_type), input/output
+!                  The tentative prolongator on input, the computed prolongator on output
+!
+!    op_restr    -  type(psb_dspmat_type), output
+!                  The restrictor operator; normally, it is the transpose of the prolongator.
+!
+!    info       -  integer, output.
+!                  Error code.
+!
+!
+subroutine amg_d_newmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
+     & ac,desc_ac,op_prol,op_restr,t_prol,info)
+  use psb_base_mod
+  use amg_d_inner_mod
+#if defined(SERIAL_MPI)
+    use amg_d_newmatch_aggregator_mod
+#else
+  use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_spmm_bld_ov
+#endif
+  implicit none
+
+  ! Arguments
+  type(psb_dspmat_type), intent(inout)    :: a
+  type(psb_desc_type), intent(inout)       :: desc_a
+  integer(psb_lpk_), intent(inout)        :: ilaggr(:), nlaggr(:)
+  type(amg_dml_parms), intent(inout)      :: parms
+  type(psb_ldspmat_type), intent(inout)   :: t_prol
+  type(psb_dspmat_type), intent(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_d_csr_sparse_mat) :: acsr
+  type(psb_ld_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_newmatch_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()
+
+#if !defined(SERIAL_MPI)
+
+  call a%mv_to(acsr)
+
+  call  amg_d_newmatch_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 '
+#endif
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+
+  return
+
+end subroutine amg_d_newmatch_spmm_bld_ov

amgprec/impl/aggregator/amg_d_parmatch_aggregator_mat_bld.F90

@@ -184,23 +184,20 @@ subroutine  amg_d_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   !
   select case (parms%aggr_prol)
   case (amg_no_smooth_)
-    call amg_d_parmatch_unsmth_bld(parms%aggr_prol,ag,a,desc_a,&
-            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,op_restr,&
-            t_prol,info)
+    call amg_d_parmatch_unsmth_bld(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_d_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_smooth_prol_)
+    call amg_d_parmatch_smth_bld(ag,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,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)
+    call amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, &
+         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
   case default
     info = psb_err_internal_error_

amgprec/impl/aggregator/amg_d_parmatch_smth_bld.F90

@@ -69,8 +69,6 @@
 !
 !
 ! Arguments:
-!    dol1smoothing - Select between l1-Jacobi and Jacobi as smoother for the
-!                  tentative prolongator
 !    a          -  type(psb_dspmat_type), input.
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -104,8 +102,8 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_d_parmatch_smth_bld(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_d_inner_mod
@@ -118,7 +116,6 @@ subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)            :: dol1smoothing
   class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
   type(psb_dspmat_type), intent(in)      :: a
   type(psb_desc_type), intent(inout)     :: desc_a
@@ -140,7 +137,7 @@ subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   type(psb_d_coo_sparse_mat)  :: coo_prol, coo_restr
   type(psb_d_csr_sparse_mat)  :: acsrf, csr_prol, acsr, tcsr
   real(psb_dpk_), allocatable :: adiag(:)
-  real(psb_dpk_), allocatable :: arwsum(:),l1rwsum(:)
+  real(psb_dpk_), allocatable :: arwsum(:)
   logical            :: filter_mat
   integer(psb_ipk_)            :: debug_level, debug_unit, err_act
   integer(psb_ipk_), parameter :: ncmax=16
@@ -148,7 +145,6 @@ subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   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
 
@@ -170,10 +166,6 @@ subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   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")
@@ -225,19 +217,6 @@ subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   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')
@@ -267,7 +246,7 @@ subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
 
       enddo
       if (jd == -1) then
-        write(0,*) name,': Warning: there is no diagonal element', i
+        write(0,*) 'Wrong input: we need the diagonal!!!!', i
       else
         acsrf%val(jd)=acsrf%val(jd)-tmp
       end if
@@ -288,10 +267,7 @@ subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
 
   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
+    if (parms%aggr_eig == amg_max_norm_) then
       allocate(arwsum(nrow))
       call acsr%arwsum(arwsum)
       anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow)))
@@ -397,7 +373,6 @@ subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
 
     end block
   end if
-  if (allocated(l1rwsum)) deallocate(l1rwsum)
   if (do_timings) call psb_toc(idx_phase2)
 
   if (debug_level >= psb_debug_outer_) &

amgprec/impl/aggregator/amg_d_parmatch_unsmth_bld.F90

@@ -68,8 +68,6 @@
 !
 !
 ! Arguments:
-!    dol1smoothing - this not actually used inside unsmoothed aggregation, it
-!                  is used just to perform a check
 !    a          -  type(psb_dspmat_type), input.
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -103,8 +101,8 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_d_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_d_parmatch_unsmth_bld(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_d_inner_mod
@@ -117,7 +115,6 @@ subroutine amg_d_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in) :: dol1smoothing
   class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
   type(psb_dspmat_type), intent(in)      :: a
   type(psb_desc_type), intent(inout)     :: desc_a
@@ -162,11 +159,6 @@ subroutine amg_d_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   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
 
 #if !defined(SERIAL_MPI)
   nglob = desc_a%get_global_rows()

amgprec/impl/aggregator/amg_d_ptap_bld.f90

@@ -76,7 +76,7 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   integer(psb_ipk_) :: nrow, ncol, nrl, nzl, ip, nzt, i, k
   integer(psb_lpk_) ::  nrsave, ncsave, nzsave, nza
   logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.  
-  integer(psb_ipk_), save :: idx_spspmm=-1, idx_cpytrans1=-1, idx_cpytrans2=-1
+  integer(psb_ipk_), save :: idx_spspmm=-1
 
   name='amg_ptap_bld'
   if(psb_get_errstatus().ne.0) return 
@@ -93,11 +93,7 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ncol  = desc_a%get_local_cols()
 
   if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("PTAP_BLD: par_spspmm")
-  if ((do_timings).and.(idx_cpytrans1==-1)) &
-       & idx_cpytrans1 = psb_get_timer_idx("PTAP_BLD: cpy&trans1")
-  if ((do_timings).and.(idx_cpytrans2==-1)) &
-       & idx_cpytrans2 = psb_get_timer_idx("PTAP_BLD: cpy&trans2")
+       & idx_spspmm = psb_get_timer_idx("SPMM_BLD: par_spspmm")
 
   naggr   = nlaggr(me+1)
   ntaggr  = sum(nlaggr)
@@ -132,7 +128,6 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ! Ok first product done.
 
   if (present(desc_ax)) then
-    if (do_timings) call psb_tic(idx_cpytrans1)
     block 
       call coo_prol%cp_to_coo(coo_restr,info)
       call coo_restr%set_ncols(desc_ac%get_local_cols())
@@ -142,7 +137,7 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
       call coo_restr%set_ncols(desc_ax%get_local_cols())
     end block
     call csr_restr%cp_from_coo(coo_restr,info)
-    if (do_timings) call psb_toc(idx_cpytrans1)
+
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999
@@ -172,28 +167,27 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
     call coo_restr%transp()
     nzl = coo_restr%get_nzeros()
-    nrl = desc_ac%get_local_rows()
-    call coo_restr%fix(info)
-    i=coo_restr%get_nzeros()
+    nrl = desc_ac%get_local_rows() 
+    i=0
     !
     ! Only keep local rows
     !
-    search: do k=i,1,-1
-      if (coo_restr%ia(k) <= nrl) then
-        call coo_restr%set_nzeros(k)
-        exit search
+    do k=1, nzl
+      if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then
+        i = i+1
+        coo_restr%val(i) = coo_restr%val(k)
+        coo_restr%ia(i)  = coo_restr%ia(k)
+        coo_restr%ja(i)  = coo_restr%ja(k)
       end if
-    end do search
-
+    end do
+    call coo_restr%set_nzeros(i)
+    call coo_restr%fix(info) 
     nzl  = coo_restr%get_nzeros()
     call coo_restr%set_nrows(desc_ac%get_local_rows())
     call coo_restr%set_ncols(desc_a%get_local_cols())
     if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
-    if (do_timings) call psb_tic(idx_cpytrans2)
-        
     call csr_restr%cp_from_coo(coo_restr,info)
 
-    if (do_timings) call psb_toc(idx_cpytrans2)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999

amgprec/impl/aggregator/amg_d_soc1_map_bld.f90

@@ -72,9 +72,7 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   use psb_base_mod
   use amg_base_prec_type
   use amg_d_inner_mod
-#if defined(OPENMP)
-  use omp_lib
-#endif
+
   implicit none
 
   ! Arguments
@@ -87,7 +85,7 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_), intent(out)               :: info
 
   ! Local variables
-  integer(psb_ipk_), allocatable :: neigh(:), irow(:), icol(:),&
+  integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:),&
        & ideg(:), idxs(:)
   integer(psb_lpk_), allocatable :: tmpaggr(:)
   real(psb_dpk_), allocatable  :: val(:), diag(:)
@@ -101,9 +99,6 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_)   :: nrow, ncol, n_ne
   integer(psb_lpk_)   :: nrglob
   character(len=20)   :: name, ch_err
-  integer(psb_ipk_), save :: idx_soc1_p1=-1, idx_soc1_p2=-1, idx_soc1_p3=-1
-  integer(psb_ipk_), save :: idx_soc1_p0=-1
-  logical, parameter      :: do_timings=.true.
 
   info=psb_success_
   name = 'amg_soc1_map_bld'
@@ -119,14 +114,6 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nrow   = desc_a%get_local_rows()
   ncol   = desc_a%get_local_cols()
   nrglob = desc_a%get_global_rows()
-  if ((do_timings).and.(idx_soc1_p0==-1))       &
-       & idx_soc1_p0 = psb_get_timer_idx("SOC1_MAP: phase0")
-  if ((do_timings).and.(idx_soc1_p1==-1))       &
-       & idx_soc1_p1 = psb_get_timer_idx("SOC1_MAP: phase1")
-  if ((do_timings).and.(idx_soc1_p2==-1))       &
-       & idx_soc1_p2 = psb_get_timer_idx("SOC1_MAP: phase2")
-  if ((do_timings).and.(idx_soc1_p3==-1))       &
-       & idx_soc1_p3 = psb_get_timer_idx("SOC1_MAP: phase3")
 
   nr = a%get_nrows()
   nc = a%get_ncols()
@@ -146,205 +133,41 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
     goto 9999
   end if
 
-  if (do_timings) call psb_tic(idx_soc1_p0)
   call a%cp_to(acsr)
-  if (do_timings) call psb_toc(idx_soc1_p0)
   if (clean_zeros) call acsr%clean_zeros(info)
   if (iorder == amg_aggr_ord_nat_) then 
-    !$omp parallel do private(i) schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
-      idxs(i)   = i
+      idxs(i)   = i 
     end do
-    !$omp end parallel do 
-  else
-    !$omp parallel do private(i) schedule(static)
+  else 
     do i=1, nr
       ilaggr(i) = -(nr+1)
       ideg(i)   = acsr%irp(i+1) - acsr%irp(i)
     end do
-    !$omp end parallel do 
     call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
   end if
-  if (do_timings) call psb_tic(idx_soc1_p1)
+
 
   !
   ! Phase one: Start with disjoint groups.
   ! 
   naggr = 0
-#if defined(OPENMP)
-  block
-    integer(psb_ipk_), allocatable  :: bnds(:), locnaggr(:)
-    integer(psb_ipk_) :: myth,nths, kk
-    ! The parallelization makes use of a locaggr(:) array; each thread
-    ! keeps its own version of naggr, and when the loop ends, a prefix is applied
-    ! to locnaggr to determine:
-    ! 1. The total number of aggregaters NAGGR;
-    ! 2. How much should each thread shift its own aggregates
-    ! Part 2 requires to keep track of which thread defined each entry
-    ! of ilaggr(), so that each entry can be adjusted correctly: even
-    ! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
-    ! been set because it is strongly connected to an entry J belonging to a
-    ! different thread. 
-
-    !$omp parallel shared(bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
-    !$omp private(icol,val,myth,kk) 
-    block
-      integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz, nc, i,j,m, nz, ilg,  ip, rsz
-      integer(psb_lpk_) :: itmp
-      !$omp master
-      nths = omp_get_num_threads()
-      allocate(bnds(0:nths),locnaggr(0:nths+1))
-      locnaggr(:) = 0
-      bnds(0) = 1
-      !$omp end master      
-      !$omp barrier
-      myth = omp_get_thread_num()
-      rsz = nr/nths
-      if (myth < mod(nr,nths)) rsz = rsz + 1
-      bnds(myth+1) = rsz
-      !$omp barrier
-      !$omp master
-      do i=1,nths
-        bnds(i) = bnds(i) + bnds(i-1)
-      end do
-      info = 0
-      !$omp end master
-      !$omp barrier
-      
-      !$omp do schedule(static) private(disjoint) 
-      do kk=0, nths-1
-        step1: do ii=bnds(kk), bnds(kk+1)-1
-          i = idxs(ii)          
-          if (info /= 0) cycle step1
-          if ((i<1).or.(i>nr)) then
-            !$omp atomic write
-            info=psb_err_internal_error_
-            !$omp end atomic 
-            call psb_errpush(info,name)
-            cycle step1
-            !goto 9999
-          end if
-            
-          if (ilaggr(i) == -(nr+1)) then
-            nz         = (acsr%irp(i+1)-acsr%irp(i))
-            if ((nz<0).or.(nz>size(icol))) then
-              !$omp atomic write
-              info=psb_err_internal_error_
-              !$omp end atomic 
-              call psb_errpush(info,name)
-              cycle step1
-              !goto 9999
-            end if
-
-            icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
-            val(1:nz)  = acsr%val(acsr%irp(i):acsr%irp(i+1)-1) 
-
-            !
-            ! Build the set of all strongly coupled nodes 
-            !
-            ip = 0
-            do k=1, nz
-              j   = icol(k)
-              ! If any of the neighbours is already assigned,
-              ! we will not reset. 
-              if (j>nr) cycle step1
-              if (ilaggr(j) > 0) cycle step1
-              if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.dzero)) then
-                ip = ip + 1
-                icol(ip) = icol(k)
-              end if
-            enddo
-            
-            !
-            ! If the whole strongly coupled neighborhood of I is
-            ! as yet unconnected, turn it into the next aggregate.
-            ! Same if ip==0 (in which case, neighborhood only
-            ! contains I even if it does not look like it from matrix)
-            ! The fact that DISJOINT is private and not under lock
-            ! generates a certain un-repeatability, in that between
-            ! computing DISJOINT and assigning, another thread might
-            ! alter the values of ILAGGR.
-            ! However, a certain unrepeatability is already present
-            ! because the sequence of aggregates is computed with a
-            ! different order than in serial mode.
-            ! In any case, even if the enteries of ILAGGR may be
-            ! overwritten, the important thing is that each entry is
-            ! consistent and they generate a correct aggregation map.
-            !
-            disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
-            if (disjoint) then
-              locnaggr(kk)     = locnaggr(kk) + 1
-              itmp = (bnds(kk)-1+locnaggr(kk)) !be careful about overflow
-              itmp = itmp*nths+kk
-              if (itmp < (bnds(kk)-1+locnaggr(kk))) then
-                !$omp atomic update
-                info = max(12345678,info)
-                !$omp end atomic
-                cycle step1
-              end if
-              !$omp atomic write
-              ilaggr(i) = itmp
-              !$omp end atomic
-              do k=1, ip
-                !$omp atomic write
-                ilaggr(icol(k)) = itmp
-                !$omp end atomic
-              end do
-            end if
-          end if
-        enddo step1
-      end do
-      !$omp end do
-
-      !$omp master
-      naggr = sum(locnaggr(0:nths-1))
-      do i=1,nths
-        locnaggr(i) = locnaggr(i) + locnaggr(i-1)
-      end do
-      do i=nths+1,1,-1
-        locnaggr(i) = locnaggr(i-1)
-      end do
-      locnaggr(0) = 0
-      !$omp end master 
-      !$omp barrier
-      !$omp  do schedule(static) 
-      do kk=0, nths-1
-        do ii=bnds(kk), bnds(kk+1)-1
-          if (ilaggr(ii) > 0) then 
-            kp = mod(ilaggr(ii),nths)
-            ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
-          end if
-        end do
-      end do
-      !$omp end do
-    end block
-    !$omp end parallel
-  end block
-  if (info /= 0) then
-    if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
-    info=psb_err_internal_error_
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-#else
+  icnt = 0
   step1: do ii=1, nr
-    if (info /= 0) cycle
     i = idxs(ii)
     if ((i<1).or.(i>nr)) then
       info=psb_err_internal_error_
       call psb_errpush(info,name)
-      cycle step1
-      !goto 9999
+      goto 9999
     end if
-
+    
     if (ilaggr(i) == -(nr+1)) then
       nz         = (acsr%irp(i+1)-acsr%irp(i))
       if ((nz<0).or.(nz>size(icol))) then
         info=psb_err_internal_error_
         call psb_errpush(info,name)
-        cycle step1
-        !goto 9999
+        goto 9999
       end if
 
       icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
@@ -353,11 +176,11 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       !
       ! Build the set of all strongly coupled nodes 
       !
-      ip = 0
+      ip = 0 
       do k=1, nz
         j   = icol(k)
         if ((1<=j).and.(j<=nr)) then 
-          if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.dzero)) then
+          if (abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))) then
             ip = ip + 1
             icol(ip) = icol(k)
           end if
@@ -371,7 +194,8 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       ! contains I even if it does not look like it from matrix)
       !
       disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
-      if (disjoint) then       
+      if (disjoint) then 
+        icnt      = icnt + 1 
         naggr     = naggr + 1
         do k=1, ip
           ilaggr(icol(k)) = naggr
@@ -380,22 +204,16 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     endif
   enddo step1
-#endif
+  
   if (debug_level >= psb_debug_outer_) then 
     write(debug_unit,*) me,' ',trim(name),&
-         & ' Check   1:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
-         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
+         & ' Check 1:',count(ilaggr == -(nr+1))
   end if
-  if (do_timings) call psb_toc(idx_soc1_p1)
-  if (do_timings) call psb_tic(idx_soc1_p2)
+
   !
   ! Phase two: join the neighbours
   !
-  !$omp workshare
   tmpaggr = ilaggr
-  !$omp end workshare
-  !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,theta)& 
-  !$omp     private(ii,i,j,k,nz,icol,val,ip,cpling)
   step2: do ii=1,nr
     i = idxs(ii)
 
@@ -426,15 +244,8 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     end if
   end do step2
-  !$omp end parallel do
-  if (do_timings) call psb_toc(idx_soc1_p2)
-  if (debug_level >= psb_debug_outer_) then 
-    write(debug_unit,*) me,' ',trim(name),&
-         & ' Check 1.5:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
-         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
-  end if
 
-  if (do_timings) call psb_tic(idx_soc1_p3)
+
   !
   ! Phase three: sweep over leftovers, if any 
   !
@@ -463,6 +274,7 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         end if
       enddo
       if (ip > 0) then
+        icnt      = icnt + 1 
         naggr     = naggr + 1
         ilaggr(i) = naggr
         do k=1, ip
@@ -480,10 +292,7 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   end do step3
 
   ! Any leftovers?
-  !$omp parallel do schedule(static) shared(ilaggr,info)& 
-  !$omp     private(ii,i,j,k,nz,icol,val,ip)
   do i=1, nr
-    if (info /= 0) cycle
     if (ilaggr(i) < 0) then
       nz = (acsr%irp(i+1)-acsr%irp(i))
       if (nz == 1) then
@@ -494,18 +303,15 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         ! other processes. 
         ilaggr(i) = -(nrglob+nr)
       else
-        !$omp atomic write
         info=psb_err_internal_error_
-        !$omp end atomic
         call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
-        cycle 
+        goto 9999
       endif
     end if
   end do
-  !$omp end parallel do
-  if (info /= 0) goto 9999
-  if (do_timings) call psb_toc(idx_soc1_p3)
+
   if (naggr > ncol) then 
+    !write(0,*) name,'Error : naggr > ncol',naggr,ncol
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')
     goto 9999
@@ -530,13 +336,9 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nlaggr(:) = 0
   nlaggr(me+1) = naggr
   call psb_sum(ctxt,nlaggr(1:np))
-  if (debug_level >= psb_debug_outer_) then 
-    write(debug_unit,*) me,' ',trim(name),&
-         & ' Check   2:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
-         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
-  end if
 
   call acsr%free()
+
   call psb_erractionrestore(err_act)
   return
 
@@ -545,3 +347,4 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   return
 
 end subroutine amg_d_soc1_map_bld
+

amgprec/impl/aggregator/amg_d_soc2_map_bld.f90

@@ -68,12 +68,9 @@
 !
 subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
 
-  use psb_base_mod 
+  use psb_base_mod
   use amg_base_prec_type
   use amg_d_inner_mod
-#if defined(OPENMP)
-  use omp_lib
-#endif
 
   implicit none
 
@@ -102,9 +99,6 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_) :: np, me
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
-  integer(psb_ipk_), save :: idx_soc2_p1=-1, idx_soc2_p2=-1, idx_soc2_p3=-1
-  integer(psb_ipk_), save :: idx_soc2_p0=-1
-  logical, parameter      :: do_timings=.true.
 
   info=psb_success_
   name = 'amg_soc2_map_bld'
@@ -120,14 +114,6 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nrow   = desc_a%get_local_rows()
   ncol   = desc_a%get_local_cols()
   nrglob = desc_a%get_global_rows()
-  if ((do_timings).and.(idx_soc2_p0==-1))       &
-       & idx_soc2_p0 = psb_get_timer_idx("SOC2_MAP: phase0")
-  if ((do_timings).and.(idx_soc2_p1==-1))       &
-       & idx_soc2_p1 = psb_get_timer_idx("SOC2_MAP: phase1")
-  if ((do_timings).and.(idx_soc2_p2==-1))       &
-       & idx_soc2_p2 = psb_get_timer_idx("SOC2_MAP: phase2")
-  if ((do_timings).and.(idx_soc2_p3==-1))       &
-       & idx_soc2_p3 = psb_get_timer_idx("SOC2_MAP: phase3")
 
   nr = a%get_nrows()
   nc = a%get_ncols()
@@ -139,7 +125,6 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
     goto 9999
   end if
 
-  if (do_timings) call psb_tic(idx_soc2_p0)
   diag = a%get_diag(info)
   if(info /= psb_success_) then
     info=psb_err_from_subroutine_
@@ -152,218 +137,55 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   ! 
   call a%cp_to(muij)
   if (clean_zeros) call muij%clean_zeros(info)
-  !$omp parallel do private(i,j,k) shared(nr,diag,muij) schedule(static)
   do i=1, nr
     do k=muij%irp(i),muij%irp(i+1)-1
       j = muij%ja(k)
       if (j<= nr) muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
     end do
   end do
-  !$omp end parallel do 
+
   !
   ! Compute the 1-neigbour; mark strong links with +1, weak links with -1
   !
   call s_neigh_coo%allocate(nr,nr,muij%get_nzeros())
-  !$omp parallel do private(i,j,k) shared(nr,diag,muij) schedule(static)
+  ip = 0 
   do i=1, nr
     do k=muij%irp(i),muij%irp(i+1)-1
       j = muij%ja(k)
-      s_neigh_coo%ia(k)  = i
-      s_neigh_coo%ja(k)  = j
       if (j<=nr) then 
+        ip = ip + 1
+        s_neigh_coo%ia(ip)  = i
+        s_neigh_coo%ja(ip)  = j
         if (real(muij%val(k)) >= theta) then 
-          s_neigh_coo%val(k) = done
+          s_neigh_coo%val(ip) = done
         else
-          s_neigh_coo%val(k) = -done
+          s_neigh_coo%val(ip) = -done
         end if
-      else
-        s_neigh_coo%val(k) = -done        
       end if
     end do
   end do
-  !$omp end parallel do
   !write(*,*) 'S_NEIGH: ',nr,ip
-  call s_neigh_coo%set_nzeros(muij%get_nzeros())
+  call s_neigh_coo%set_nzeros(ip)
   call s_neigh%mv_from_coo(s_neigh_coo,info)
 
-  if (iorder == amg_aggr_ord_nat_) then
-    
-    !$omp parallel do private(i) shared(ilaggr,idxs) schedule(static)
+  if (iorder == amg_aggr_ord_nat_) then 
     do i=1, nr
       ilaggr(i) = -(nr+1)
       idxs(i)   = i 
     end do
-    !$omp end parallel do 
   else 
-    !$omp parallel do private(i) shared(ilaggr,idxs,muij)  schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
       ideg(i)   = muij%irp(i+1) - muij%irp(i)
     end do
-    !$omp end parallel do
     call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
   end if
 
-  if (do_timings) call psb_toc(idx_soc2_p0)
-  if (do_timings) call psb_tic(idx_soc2_p1)
 
   !
   ! Phase one: Start with disjoint groups.
   ! 
   naggr = 0
-#if defined(OPENMP)
-  block
-    integer(psb_ipk_), allocatable  :: bnds(:), locnaggr(:)
-    integer(psb_ipk_) :: myth,nths, kk
-    ! The parallelization makes use of a locaggr(:) array; each thread
-    ! keeps its own version of naggr, and when the loop ends, a prefix is applied
-    ! to locnaggr to determine:
-    ! 1. The total number of aggregaters NAGGR;
-    ! 2. How much should each thread shift its own aggregates
-    ! Part 2 requires to keep track of which thread defined each entry
-    ! of ilaggr(), so that each entry can be adjusted correctly: even
-    ! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
-    ! been set because it is strongly connected to an entry J belonging to a
-    ! different thread. 
-
-    !$omp parallel shared(s_neigh,bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
-    !$omp private(icol,val,myth,kk) 
-    block
-      integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz,nc,i,j,m,nz,ilg,ip,rsz,ip1,nzcnt
-      integer(psb_lpk_) :: itmp
-      !$omp master
-      nths = omp_get_num_threads()
-      allocate(bnds(0:nths),locnaggr(0:nths+1))
-      locnaggr(:) = 0
-      bnds(0) = 1
-      !$omp end master      
-      !$omp barrier
-      myth = omp_get_thread_num()
-      rsz = nr/nths
-      if (myth < mod(nr,nths)) rsz = rsz + 1
-      bnds(myth+1) = rsz
-      !$omp barrier
-      !$omp master
-      do i=1,nths
-        bnds(i) = bnds(i) + bnds(i-1)
-      end do
-      info = 0
-      !$omp end master
-      !$omp barrier
-
-      !$omp do schedule(static) private(disjoint) 
-      do kk=0, nths-1
-        step1: do ii=bnds(kk), bnds(kk+1)-1
-          i = idxs(ii)
-          if (info /= 0) then
-            write(0,*) ' Step1:',kk,ii,i,info
-            cycle step1
-          end if
-          if ((i<1).or.(i>nr)) then
-            !$omp atomic write
-            info=psb_err_internal_error_
-            !$omp end atomic 
-            call psb_errpush(info,name)
-            cycle step1
-            !goto 9999
-          end if
-
-
-          if (ilaggr(i) == -(nr+1)) then 
-            !
-            ! Get the 1-neighbourhood of I 
-            !
-            ip1 = s_neigh%irp(i)
-            nz  = s_neigh%irp(i+1)-ip1
-            !
-            ! If the neighbourhood only contains I, skip it
-            !
-            if (nz ==0) then
-              ilaggr(i) = 0
-              cycle step1
-            end if
-            if ((nz==1).and.(s_neigh%ja(ip1)==i)) then
-              ilaggr(i) = 0
-              cycle step1
-            end if
-
-            nzcnt = count(real(s_neigh%val(ip1:ip1+nz-1)) > 0)
-            icol(1:nzcnt) = pack(s_neigh%ja(ip1:ip1+nz-1),(real(s_neigh%val(ip1:ip1+nz-1)) > 0))
-            disjoint = all(ilaggr(icol(1:nzcnt)) == -(nr+1)) 
-
-            !
-            ! If the whole strongly coupled neighborhood of I is
-            ! as yet unconnected, turn it into the next aggregate.
-            ! Same if ip==0 (in which case, neighborhood only
-            ! contains I even if it does not look like it from matrix)
-            ! The fact that DISJOINT is private and not under lock
-            ! generates a certain un-repeatability, in that between
-            ! computing DISJOINT and assigning, another thread might
-            ! alter the values of ILAGGR.
-            ! However, a certain unrepeatability is already present
-            ! because the sequence of aggregates is computed with a
-            ! different order than in serial mode.
-            ! In any case, even if the enteries of ILAGGR may be
-            ! overwritten, the important thing is that each entry is
-            ! consistent and they generate a correct aggregation map.
-            !
-            if (disjoint) then
-              locnaggr(kk)     = locnaggr(kk) + 1
-              itmp = (bnds(kk)-1+locnaggr(kk)) !be careful about overflow
-              itmp = itmp*nths+kk
-              if (itmp < (bnds(kk)-1+locnaggr(kk))) then
-                !$omp atomic update
-                info = max(12345678,info)
-                !$omp end atomic
-                cycle step1
-              end if
-              !$omp atomic write
-              ilaggr(i) = itmp
-              !$omp end atomic
-              do k=1, nzcnt
-                !$omp atomic write
-                ilaggr(icol(k)) = itmp
-                !$omp end atomic
-              end do
-            end if
-          end if
-        enddo step1
-      end do
-      !$omp end do
-
-      !$omp master
-      naggr = sum(locnaggr(0:nths-1))
-      do i=1,nths
-        locnaggr(i) = locnaggr(i) + locnaggr(i-1)
-      end do
-      do i=nths+1,1,-1
-        locnaggr(i) = locnaggr(i-1)
-      end do
-      locnaggr(0) = 0
-      !write(0,*) 'LNAG ',locnaggr(nths+1)
-      !$omp end master 
-      !$omp barrier
-      !$omp  do schedule(static) 
-      do kk=0, nths-1
-        do ii=bnds(kk), bnds(kk+1)-1
-          if (ilaggr(ii) > 0) then 
-            kp = mod(ilaggr(ii),nths)
-            ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
-          end if
-        end do
-      end do
-      !$omp end do
-    end block
-    !$omp end parallel
-  end block
-  if (info /= 0) then
-    if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
-    info=psb_err_internal_error_
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-
-#else
   icnt = 0
   step1: do ii=1, nr
     i = idxs(ii)
@@ -402,21 +224,16 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     endif
   enddo step1
-#endif  
+  
   if (debug_level >= psb_debug_outer_) then 
     write(debug_unit,*) me,' ',trim(name),&
          & ' Check 1:',count(ilaggr == -(nr+1))
   end if
-  if (do_timings) call psb_toc(idx_soc2_p1)
-  if (do_timings) call psb_tic(idx_soc2_p2)
+
   !
   ! Phase two: join the neighbours
   !
-  !$omp workshare
   tmpaggr = ilaggr
-  !$omp end workshare
-  !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,muij,s_neigh)& 
-  !$omp     private(ii,i,j,k,nz,icol,val,ip,cpling)
   step2: do ii=1,nr
     i = idxs(ii)
 
@@ -442,9 +259,8 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     end if
   end do step2
-  !$omp end parallel do
-  if (do_timings) call psb_toc(idx_soc2_p2)
-  if (do_timings) call psb_tic(idx_soc2_p3)
+
+
   !
   ! Phase three: sweep over leftovers, if any 
   !
@@ -478,8 +294,6 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   end do step3
 
   ! Any leftovers?
-  !$omp parallel do schedule(static) shared(ilaggr,s_neigh,info)& 
-  !$omp     private(ii,i,j,k)
   do i=1, nr
     if (ilaggr(i) <= 0) then
       nz = (s_neigh%irp(i+1)-s_neigh%irp(i))
@@ -491,17 +305,13 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         ! other processes. 
         ilaggr(i) = -(nrglob+nr)
       else
-        !$omp atomic write
         info=psb_err_internal_error_
-        !$omp end atomic
         call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
-        cycle
+        goto 9999
       endif
     end if
   end do
-  !$omp end parallel do
-  if (info /= 0) goto 9999
-  if (do_timings) call psb_toc(idx_soc2_p3)  
+
   if (naggr > ncol) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')

amgprec/impl/aggregator/amg_daggrmat_minnrg_bld.f90

@@ -69,7 +69,6 @@
 !
 !
 ! Arguments:
-!    dol1smoothing - fictitious integer argument, it is not used inside
 !    a          -  type(psb_dspmat_type), input.     
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -105,8 +104,8 @@
 !                  Error code.
 !
 !
-subroutine amg_daggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_daggrmat_minnrg_bld(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_d_inner_mod, amg_protect_name => amg_daggrmat_minnrg_bld
@@ -114,7 +113,6 @@ subroutine amg_daggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)                 :: dol1smoothing
   type(psb_dspmat_type), intent(in)           :: a
   type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
@@ -173,13 +171,6 @@ subroutine amg_daggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 
   filter_mat = (parms%aggr_filter == amg_filter_mat_)
 
-  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
-
-
   !NEEDS TO BE REWORKED !!
   
   ! naggr: number of local aggregates
@@ -309,7 +300,7 @@ subroutine amg_daggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 !!$        endif
 !!$      enddo
 !!$      if (jd == -1) then 
-!!$                write(0,*) name,': Warning: there is no diagonal element', i
+!!$        write(0,*) 'Wrong input: we need the diagonal!!!!', i
 !!$      else
 !!$        acsrf%val(jd)=acsrf%val(jd)-tmp
 !!$      end if

amgprec/impl/aggregator/amg_daggrmat_nosmth_bld.f90

@@ -94,11 +94,10 @@
 !               
 !    info       -  integer, output.
 !                  Error code.
-!    dol1smoothing - optional, this is here just for interfacing reasons. It is not used by the
-!                    code
 !
-subroutine amg_daggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+!
+subroutine amg_daggrmat_nosmth_bld(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_d_inner_mod, amg_protect_name => amg_daggrmat_nosmth_bld
@@ -106,7 +105,6 @@ subroutine amg_daggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)              :: dol1smoothing 
   type(psb_dspmat_type), intent(in)        :: a
   type(psb_desc_type), intent(inout)         :: desc_a
   integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
@@ -139,12 +137,6 @@ subroutine amg_daggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 
   ctxt = desc_a%get_context()
   call psb_info(ctxt, 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()

amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90

@@ -69,8 +69,6 @@
 !
 !
 ! Arguments:
-!    dol1smooth -  Integer taking the type of smoother that has to be used
-!                  on the tentative prolongator
 !    a          -  type(psb_dspmat_type), input.     
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -104,8 +102,8 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_daggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_daggrmat_smth_bld(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_d_inner_mod, amg_protect_name => amg_daggrmat_smth_bld
@@ -114,7 +112,6 @@ subroutine amg_daggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)            :: dol1smoothing
   type(psb_dspmat_type), intent(in)      :: a
   type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
@@ -135,7 +132,7 @@ subroutine amg_daggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   type(psb_d_coo_sparse_mat) :: coo_prol, coo_restr
   type(psb_d_csr_sparse_mat) :: acsr1,  acsrf, csr_prol, acsr
   real(psb_dpk_), allocatable :: adiag(:)
-  real(psb_dpk_), allocatable :: arwsum(:),l1rwsum(:)
+  real(psb_dpk_), allocatable :: arwsum(:)
   integer(psb_ipk_)  :: ierr(5)
   logical            :: filter_mat
   integer(psb_ipk_)            :: debug_level, debug_unit, err_act
@@ -144,7 +141,6 @@ subroutine amg_daggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   logical, parameter :: debug_new=.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
   integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1
 
@@ -177,9 +173,6 @@ subroutine amg_daggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   if ((do_timings).and.(idx_ptap==-1)) &
        & idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld  ")
 
-  ! check if we have to use Jacobi or l1-Jacobi to smooth the tentative prolongator
-  if (dol1smoothing.eq.amg_l1_smooth_prol_) do_l1correction=.true.
-
 
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
@@ -207,24 +200,6 @@ subroutine amg_daggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
   if (info == psb_success_) call a%cp_to(acsr)
-  !
-  ! Do the l1-correction on the diagonal if it is requested
-  !
-  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}|
-    !$OMP parallel do private(i) schedule(static)
-    do i=1,size(adiag)
-      adiag(i) = adiag(i) + l1rwsum(i) - abs(adiag(i))
-    end do
-    !$OMP end parallel do
-  end if
-
 
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
@@ -255,7 +230,6 @@ subroutine amg_daggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 
       enddo
       if (jd == -1) then 
-        ! if (.not.do_l1correction) 
         write(0,*) 'Wrong input: we need the diagonal!!!!', i
       else
         acsrf%val(jd)=acsrf%val(jd)-tmp
@@ -278,10 +252,6 @@ subroutine amg_daggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   !$OMP end parallel do 
   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
-    !
     if (parms%aggr_eig == amg_max_norm_) then 
       allocate(arwsum(nrow))
       call acsr%arwsum(arwsum)      
@@ -289,6 +259,7 @@ subroutine amg_daggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
       call psb_amx(ctxt,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_')
@@ -351,7 +322,6 @@ subroutine amg_daggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '
-  if (allocated(l1rwsum)) deallocate(l1rwsum)
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_s_dec_aggregator_mat_bld.f90

@@ -177,24 +177,23 @@ subroutine  amg_s_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   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(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_) 
 
-    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(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)
+    call amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, &
+         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
   case default
     info = psb_err_internal_error_

amgprec/impl/aggregator/amg_s_parmatch_aggregator_mat_bld.F90

@@ -184,23 +184,20 @@ subroutine  amg_s_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   !
   select case (parms%aggr_prol)
   case (amg_no_smooth_)
-    call amg_s_parmatch_unsmth_bld(parms%aggr_prol,ag,a,desc_a,&
-            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,op_restr,&
-            t_prol,info)
+    call amg_s_parmatch_unsmth_bld(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_s_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_smooth_prol_)
+    call amg_s_parmatch_smth_bld(ag,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,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)
+    call amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, &
+         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
   case default
     info = psb_err_internal_error_

amgprec/impl/aggregator/amg_s_parmatch_smth_bld.F90

@@ -69,8 +69,6 @@
 !
 !
 ! Arguments:
-!    dol1smoothing - Select between l1-Jacobi and Jacobi as smoother for the
-!                  tentative prolongator
 !    a          -  type(psb_sspmat_type), input.
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -104,8 +102,8 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_s_parmatch_smth_bld(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_s_inner_mod
@@ -118,7 +116,6 @@ subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)            :: dol1smoothing
   class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
   type(psb_sspmat_type), intent(in)      :: a
   type(psb_desc_type), intent(inout)     :: desc_a
@@ -140,7 +137,7 @@ subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   type(psb_s_coo_sparse_mat)  :: coo_prol, coo_restr
   type(psb_s_csr_sparse_mat)  :: acsrf, csr_prol, acsr, tcsr
   real(psb_spk_), allocatable :: adiag(:)
-  real(psb_spk_), allocatable :: arwsum(:),l1rwsum(:)
+  real(psb_spk_), allocatable :: arwsum(:)
   logical            :: filter_mat
   integer(psb_ipk_)            :: debug_level, debug_unit, err_act
   integer(psb_ipk_), parameter :: ncmax=16
@@ -148,7 +145,6 @@ subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   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
 
@@ -170,10 +166,6 @@ subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   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")
@@ -225,19 +217,6 @@ subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   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')
@@ -267,7 +246,7 @@ subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
 
       enddo
       if (jd == -1) then
-        write(0,*) name,': Warning: there is no diagonal element', i
+        write(0,*) 'Wrong input: we need the diagonal!!!!', i
       else
         acsrf%val(jd)=acsrf%val(jd)-tmp
       end if
@@ -288,10 +267,7 @@ subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
 
   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
+    if (parms%aggr_eig == amg_max_norm_) then
       allocate(arwsum(nrow))
       call acsr%arwsum(arwsum)
       anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow)))
@@ -397,7 +373,6 @@ subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
 
     end block
   end if
-  if (allocated(l1rwsum)) deallocate(l1rwsum)
   if (do_timings) call psb_toc(idx_phase2)
 
   if (debug_level >= psb_debug_outer_) &

amgprec/impl/aggregator/amg_s_parmatch_unsmth_bld.F90

@@ -68,8 +68,6 @@
 !
 !
 ! Arguments:
-!    dol1smoothing - this not actually used inside unsmoothed aggregation, it
-!                  is used just to perform a check
 !    a          -  type(psb_sspmat_type), input.
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -103,8 +101,8 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_s_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_s_parmatch_unsmth_bld(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_s_inner_mod
@@ -117,7 +115,6 @@ subroutine amg_s_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in) :: dol1smoothing
   class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
   type(psb_sspmat_type), intent(in)      :: a
   type(psb_desc_type), intent(inout)     :: desc_a
@@ -162,11 +159,6 @@ subroutine amg_s_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,&
   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
 
 #if !defined(SERIAL_MPI)
   nglob = desc_a%get_global_rows()

amgprec/impl/aggregator/amg_s_ptap_bld.f90

@@ -76,7 +76,7 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   integer(psb_ipk_) :: nrow, ncol, nrl, nzl, ip, nzt, i, k
   integer(psb_lpk_) ::  nrsave, ncsave, nzsave, nza
   logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.  
-  integer(psb_ipk_), save :: idx_spspmm=-1, idx_cpytrans1=-1, idx_cpytrans2=-1
+  integer(psb_ipk_), save :: idx_spspmm=-1
 
   name='amg_ptap_bld'
   if(psb_get_errstatus().ne.0) return 
@@ -93,11 +93,7 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ncol  = desc_a%get_local_cols()
 
   if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("PTAP_BLD: par_spspmm")
-  if ((do_timings).and.(idx_cpytrans1==-1)) &
-       & idx_cpytrans1 = psb_get_timer_idx("PTAP_BLD: cpy&trans1")
-  if ((do_timings).and.(idx_cpytrans2==-1)) &
-       & idx_cpytrans2 = psb_get_timer_idx("PTAP_BLD: cpy&trans2")
+       & idx_spspmm = psb_get_timer_idx("SPMM_BLD: par_spspmm")
 
   naggr   = nlaggr(me+1)
   ntaggr  = sum(nlaggr)
@@ -132,7 +128,6 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ! Ok first product done.
 
   if (present(desc_ax)) then
-    if (do_timings) call psb_tic(idx_cpytrans1)
     block 
       call coo_prol%cp_to_coo(coo_restr,info)
       call coo_restr%set_ncols(desc_ac%get_local_cols())
@@ -142,7 +137,7 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
       call coo_restr%set_ncols(desc_ax%get_local_cols())
     end block
     call csr_restr%cp_from_coo(coo_restr,info)
-    if (do_timings) call psb_toc(idx_cpytrans1)
+
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999
@@ -172,28 +167,27 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
     call coo_restr%transp()
     nzl = coo_restr%get_nzeros()
-    nrl = desc_ac%get_local_rows()
-    call coo_restr%fix(info)
-    i=coo_restr%get_nzeros()
+    nrl = desc_ac%get_local_rows() 
+    i=0
     !
     ! Only keep local rows
     !
-    search: do k=i,1,-1
-      if (coo_restr%ia(k) <= nrl) then
-        call coo_restr%set_nzeros(k)
-        exit search
+    do k=1, nzl
+      if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then
+        i = i+1
+        coo_restr%val(i) = coo_restr%val(k)
+        coo_restr%ia(i)  = coo_restr%ia(k)
+        coo_restr%ja(i)  = coo_restr%ja(k)
       end if
-    end do search
-
+    end do
+    call coo_restr%set_nzeros(i)
+    call coo_restr%fix(info) 
     nzl  = coo_restr%get_nzeros()
     call coo_restr%set_nrows(desc_ac%get_local_rows())
     call coo_restr%set_ncols(desc_a%get_local_cols())
     if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
-    if (do_timings) call psb_tic(idx_cpytrans2)
-        
     call csr_restr%cp_from_coo(coo_restr,info)
 
-    if (do_timings) call psb_toc(idx_cpytrans2)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999

amgprec/impl/aggregator/amg_s_soc1_map_bld.f90

@@ -72,9 +72,7 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   use psb_base_mod
   use amg_base_prec_type
   use amg_s_inner_mod
-#if defined(OPENMP)
-  use omp_lib
-#endif
+
   implicit none
 
   ! Arguments
@@ -87,7 +85,7 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_), intent(out)               :: info
 
   ! Local variables
-  integer(psb_ipk_), allocatable :: neigh(:), irow(:), icol(:),&
+  integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:),&
        & ideg(:), idxs(:)
   integer(psb_lpk_), allocatable :: tmpaggr(:)
   real(psb_spk_), allocatable  :: val(:), diag(:)
@@ -101,9 +99,6 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_)   :: nrow, ncol, n_ne
   integer(psb_lpk_)   :: nrglob
   character(len=20)   :: name, ch_err
-  integer(psb_ipk_), save :: idx_soc1_p1=-1, idx_soc1_p2=-1, idx_soc1_p3=-1
-  integer(psb_ipk_), save :: idx_soc1_p0=-1
-  logical, parameter      :: do_timings=.true.
 
   info=psb_success_
   name = 'amg_soc1_map_bld'
@@ -119,14 +114,6 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nrow   = desc_a%get_local_rows()
   ncol   = desc_a%get_local_cols()
   nrglob = desc_a%get_global_rows()
-  if ((do_timings).and.(idx_soc1_p0==-1))       &
-       & idx_soc1_p0 = psb_get_timer_idx("SOC1_MAP: phase0")
-  if ((do_timings).and.(idx_soc1_p1==-1))       &
-       & idx_soc1_p1 = psb_get_timer_idx("SOC1_MAP: phase1")
-  if ((do_timings).and.(idx_soc1_p2==-1))       &
-       & idx_soc1_p2 = psb_get_timer_idx("SOC1_MAP: phase2")
-  if ((do_timings).and.(idx_soc1_p3==-1))       &
-       & idx_soc1_p3 = psb_get_timer_idx("SOC1_MAP: phase3")
 
   nr = a%get_nrows()
   nc = a%get_ncols()
@@ -146,205 +133,41 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
     goto 9999
   end if
 
-  if (do_timings) call psb_tic(idx_soc1_p0)
   call a%cp_to(acsr)
-  if (do_timings) call psb_toc(idx_soc1_p0)
   if (clean_zeros) call acsr%clean_zeros(info)
   if (iorder == amg_aggr_ord_nat_) then 
-    !$omp parallel do private(i) schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
-      idxs(i)   = i
+      idxs(i)   = i 
     end do
-    !$omp end parallel do 
-  else
-    !$omp parallel do private(i) schedule(static)
+  else 
     do i=1, nr
       ilaggr(i) = -(nr+1)
       ideg(i)   = acsr%irp(i+1) - acsr%irp(i)
     end do
-    !$omp end parallel do 
     call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
   end if
-  if (do_timings) call psb_tic(idx_soc1_p1)
+
 
   !
   ! Phase one: Start with disjoint groups.
   ! 
   naggr = 0
-#if defined(OPENMP)
-  block
-    integer(psb_ipk_), allocatable  :: bnds(:), locnaggr(:)
-    integer(psb_ipk_) :: myth,nths, kk
-    ! The parallelization makes use of a locaggr(:) array; each thread
-    ! keeps its own version of naggr, and when the loop ends, a prefix is applied
-    ! to locnaggr to determine:
-    ! 1. The total number of aggregaters NAGGR;
-    ! 2. How much should each thread shift its own aggregates
-    ! Part 2 requires to keep track of which thread defined each entry
-    ! of ilaggr(), so that each entry can be adjusted correctly: even
-    ! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
-    ! been set because it is strongly connected to an entry J belonging to a
-    ! different thread. 
-
-    !$omp parallel shared(bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
-    !$omp private(icol,val,myth,kk) 
-    block
-      integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz, nc, i,j,m, nz, ilg,  ip, rsz
-      integer(psb_lpk_) :: itmp
-      !$omp master
-      nths = omp_get_num_threads()
-      allocate(bnds(0:nths),locnaggr(0:nths+1))
-      locnaggr(:) = 0
-      bnds(0) = 1
-      !$omp end master      
-      !$omp barrier
-      myth = omp_get_thread_num()
-      rsz = nr/nths
-      if (myth < mod(nr,nths)) rsz = rsz + 1
-      bnds(myth+1) = rsz
-      !$omp barrier
-      !$omp master
-      do i=1,nths
-        bnds(i) = bnds(i) + bnds(i-1)
-      end do
-      info = 0
-      !$omp end master
-      !$omp barrier
-      
-      !$omp do schedule(static) private(disjoint) 
-      do kk=0, nths-1
-        step1: do ii=bnds(kk), bnds(kk+1)-1
-          i = idxs(ii)          
-          if (info /= 0) cycle step1
-          if ((i<1).or.(i>nr)) then
-            !$omp atomic write
-            info=psb_err_internal_error_
-            !$omp end atomic 
-            call psb_errpush(info,name)
-            cycle step1
-            !goto 9999
-          end if
-            
-          if (ilaggr(i) == -(nr+1)) then
-            nz         = (acsr%irp(i+1)-acsr%irp(i))
-            if ((nz<0).or.(nz>size(icol))) then
-              !$omp atomic write
-              info=psb_err_internal_error_
-              !$omp end atomic 
-              call psb_errpush(info,name)
-              cycle step1
-              !goto 9999
-            end if
-
-            icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
-            val(1:nz)  = acsr%val(acsr%irp(i):acsr%irp(i+1)-1) 
-
-            !
-            ! Build the set of all strongly coupled nodes 
-            !
-            ip = 0
-            do k=1, nz
-              j   = icol(k)
-              ! If any of the neighbours is already assigned,
-              ! we will not reset. 
-              if (j>nr) cycle step1
-              if (ilaggr(j) > 0) cycle step1
-              if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.szero)) then
-                ip = ip + 1
-                icol(ip) = icol(k)
-              end if
-            enddo
-            
-            !
-            ! If the whole strongly coupled neighborhood of I is
-            ! as yet unconnected, turn it into the next aggregate.
-            ! Same if ip==0 (in which case, neighborhood only
-            ! contains I even if it does not look like it from matrix)
-            ! The fact that DISJOINT is private and not under lock
-            ! generates a certain un-repeatability, in that between
-            ! computing DISJOINT and assigning, another thread might
-            ! alter the values of ILAGGR.
-            ! However, a certain unrepeatability is already present
-            ! because the sequence of aggregates is computed with a
-            ! different order than in serial mode.
-            ! In any case, even if the enteries of ILAGGR may be
-            ! overwritten, the important thing is that each entry is
-            ! consistent and they generate a correct aggregation map.
-            !
-            disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
-            if (disjoint) then
-              locnaggr(kk)     = locnaggr(kk) + 1
-              itmp = (bnds(kk)-1+locnaggr(kk)) !be careful about overflow
-              itmp = itmp*nths+kk
-              if (itmp < (bnds(kk)-1+locnaggr(kk))) then
-                !$omp atomic update
-                info = max(12345678,info)
-                !$omp end atomic
-                cycle step1
-              end if
-              !$omp atomic write
-              ilaggr(i) = itmp
-              !$omp end atomic
-              do k=1, ip
-                !$omp atomic write
-                ilaggr(icol(k)) = itmp
-                !$omp end atomic
-              end do
-            end if
-          end if
-        enddo step1
-      end do
-      !$omp end do
-
-      !$omp master
-      naggr = sum(locnaggr(0:nths-1))
-      do i=1,nths
-        locnaggr(i) = locnaggr(i) + locnaggr(i-1)
-      end do
-      do i=nths+1,1,-1
-        locnaggr(i) = locnaggr(i-1)
-      end do
-      locnaggr(0) = 0
-      !$omp end master 
-      !$omp barrier
-      !$omp  do schedule(static) 
-      do kk=0, nths-1
-        do ii=bnds(kk), bnds(kk+1)-1
-          if (ilaggr(ii) > 0) then 
-            kp = mod(ilaggr(ii),nths)
-            ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
-          end if
-        end do
-      end do
-      !$omp end do
-    end block
-    !$omp end parallel
-  end block
-  if (info /= 0) then
-    if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
-    info=psb_err_internal_error_
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-#else
+  icnt = 0
   step1: do ii=1, nr
-    if (info /= 0) cycle
     i = idxs(ii)
     if ((i<1).or.(i>nr)) then
       info=psb_err_internal_error_
       call psb_errpush(info,name)
-      cycle step1
-      !goto 9999
+      goto 9999
     end if
-
+    
     if (ilaggr(i) == -(nr+1)) then
       nz         = (acsr%irp(i+1)-acsr%irp(i))
       if ((nz<0).or.(nz>size(icol))) then
         info=psb_err_internal_error_
         call psb_errpush(info,name)
-        cycle step1
-        !goto 9999
+        goto 9999
       end if
 
       icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
@@ -353,11 +176,11 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       !
       ! Build the set of all strongly coupled nodes 
       !
-      ip = 0
+      ip = 0 
       do k=1, nz
         j   = icol(k)
         if ((1<=j).and.(j<=nr)) then 
-          if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.szero)) then
+          if (abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))) then
             ip = ip + 1
             icol(ip) = icol(k)
           end if
@@ -371,7 +194,8 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       ! contains I even if it does not look like it from matrix)
       !
       disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
-      if (disjoint) then       
+      if (disjoint) then 
+        icnt      = icnt + 1 
         naggr     = naggr + 1
         do k=1, ip
           ilaggr(icol(k)) = naggr
@@ -380,22 +204,16 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     endif
   enddo step1
-#endif
+  
   if (debug_level >= psb_debug_outer_) then 
     write(debug_unit,*) me,' ',trim(name),&
-         & ' Check   1:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
-         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
+         & ' Check 1:',count(ilaggr == -(nr+1))
   end if
-  if (do_timings) call psb_toc(idx_soc1_p1)
-  if (do_timings) call psb_tic(idx_soc1_p2)
+
   !
   ! Phase two: join the neighbours
   !
-  !$omp workshare
   tmpaggr = ilaggr
-  !$omp end workshare
-  !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,theta)& 
-  !$omp     private(ii,i,j,k,nz,icol,val,ip,cpling)
   step2: do ii=1,nr
     i = idxs(ii)
 
@@ -426,15 +244,8 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     end if
   end do step2
-  !$omp end parallel do
-  if (do_timings) call psb_toc(idx_soc1_p2)
-  if (debug_level >= psb_debug_outer_) then 
-    write(debug_unit,*) me,' ',trim(name),&
-         & ' Check 1.5:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
-         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
-  end if
 
-  if (do_timings) call psb_tic(idx_soc1_p3)
+
   !
   ! Phase three: sweep over leftovers, if any 
   !
@@ -463,6 +274,7 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         end if
       enddo
       if (ip > 0) then
+        icnt      = icnt + 1 
         naggr     = naggr + 1
         ilaggr(i) = naggr
         do k=1, ip
@@ -480,10 +292,7 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   end do step3
 
   ! Any leftovers?
-  !$omp parallel do schedule(static) shared(ilaggr,info)& 
-  !$omp     private(ii,i,j,k,nz,icol,val,ip)
   do i=1, nr
-    if (info /= 0) cycle
     if (ilaggr(i) < 0) then
       nz = (acsr%irp(i+1)-acsr%irp(i))
       if (nz == 1) then
@@ -494,18 +303,15 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         ! other processes. 
         ilaggr(i) = -(nrglob+nr)
       else
-        !$omp atomic write
         info=psb_err_internal_error_
-        !$omp end atomic
         call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
-        cycle 
+        goto 9999
       endif
     end if
   end do
-  !$omp end parallel do
-  if (info /= 0) goto 9999
-  if (do_timings) call psb_toc(idx_soc1_p3)
+
   if (naggr > ncol) then 
+    !write(0,*) name,'Error : naggr > ncol',naggr,ncol
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')
     goto 9999
@@ -530,13 +336,9 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nlaggr(:) = 0
   nlaggr(me+1) = naggr
   call psb_sum(ctxt,nlaggr(1:np))
-  if (debug_level >= psb_debug_outer_) then 
-    write(debug_unit,*) me,' ',trim(name),&
-         & ' Check   2:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
-         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
-  end if
 
   call acsr%free()
+
   call psb_erractionrestore(err_act)
   return
 
@@ -545,3 +347,4 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   return
 
 end subroutine amg_s_soc1_map_bld
+

amgprec/impl/aggregator/amg_s_soc2_map_bld.f90

@@ -68,12 +68,9 @@
 !
 subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
 
-  use psb_base_mod 
+  use psb_base_mod
   use amg_base_prec_type
   use amg_s_inner_mod
-#if defined(OPENMP)
-  use omp_lib
-#endif
 
   implicit none
 
@@ -102,9 +99,6 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_) :: np, me
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
-  integer(psb_ipk_), save :: idx_soc2_p1=-1, idx_soc2_p2=-1, idx_soc2_p3=-1
-  integer(psb_ipk_), save :: idx_soc2_p0=-1
-  logical, parameter      :: do_timings=.true.
 
   info=psb_success_
   name = 'amg_soc2_map_bld'
@@ -120,14 +114,6 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nrow   = desc_a%get_local_rows()
   ncol   = desc_a%get_local_cols()
   nrglob = desc_a%get_global_rows()
-  if ((do_timings).and.(idx_soc2_p0==-1))       &
-       & idx_soc2_p0 = psb_get_timer_idx("SOC2_MAP: phase0")
-  if ((do_timings).and.(idx_soc2_p1==-1))       &
-       & idx_soc2_p1 = psb_get_timer_idx("SOC2_MAP: phase1")
-  if ((do_timings).and.(idx_soc2_p2==-1))       &
-       & idx_soc2_p2 = psb_get_timer_idx("SOC2_MAP: phase2")
-  if ((do_timings).and.(idx_soc2_p3==-1))       &
-       & idx_soc2_p3 = psb_get_timer_idx("SOC2_MAP: phase3")
 
   nr = a%get_nrows()
   nc = a%get_ncols()
@@ -139,7 +125,6 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
     goto 9999
   end if
 
-  if (do_timings) call psb_tic(idx_soc2_p0)
   diag = a%get_diag(info)
   if(info /= psb_success_) then
     info=psb_err_from_subroutine_
@@ -152,218 +137,55 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   ! 
   call a%cp_to(muij)
   if (clean_zeros) call muij%clean_zeros(info)
-  !$omp parallel do private(i,j,k) shared(nr,diag,muij) schedule(static)
   do i=1, nr
     do k=muij%irp(i),muij%irp(i+1)-1
       j = muij%ja(k)
       if (j<= nr) muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
     end do
   end do
-  !$omp end parallel do 
+
   !
   ! Compute the 1-neigbour; mark strong links with +1, weak links with -1
   !
   call s_neigh_coo%allocate(nr,nr,muij%get_nzeros())
-  !$omp parallel do private(i,j,k) shared(nr,diag,muij) schedule(static)
+  ip = 0 
   do i=1, nr
     do k=muij%irp(i),muij%irp(i+1)-1
       j = muij%ja(k)
-      s_neigh_coo%ia(k)  = i
-      s_neigh_coo%ja(k)  = j
       if (j<=nr) then 
+        ip = ip + 1
+        s_neigh_coo%ia(ip)  = i
+        s_neigh_coo%ja(ip)  = j
         if (real(muij%val(k)) >= theta) then 
-          s_neigh_coo%val(k) = sone
+          s_neigh_coo%val(ip) = sone
         else
-          s_neigh_coo%val(k) = -sone
+          s_neigh_coo%val(ip) = -sone
         end if
-      else
-        s_neigh_coo%val(k) = -sone        
       end if
     end do
   end do
-  !$omp end parallel do
   !write(*,*) 'S_NEIGH: ',nr,ip
-  call s_neigh_coo%set_nzeros(muij%get_nzeros())
+  call s_neigh_coo%set_nzeros(ip)
   call s_neigh%mv_from_coo(s_neigh_coo,info)
 
-  if (iorder == amg_aggr_ord_nat_) then
-    
-    !$omp parallel do private(i) shared(ilaggr,idxs) schedule(static)
+  if (iorder == amg_aggr_ord_nat_) then 
     do i=1, nr
       ilaggr(i) = -(nr+1)
       idxs(i)   = i 
     end do
-    !$omp end parallel do 
   else 
-    !$omp parallel do private(i) shared(ilaggr,idxs,muij)  schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
       ideg(i)   = muij%irp(i+1) - muij%irp(i)
     end do
-    !$omp end parallel do
     call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
   end if
 
-  if (do_timings) call psb_toc(idx_soc2_p0)
-  if (do_timings) call psb_tic(idx_soc2_p1)
 
   !
   ! Phase one: Start with disjoint groups.
   ! 
   naggr = 0
-#if defined(OPENMP)
-  block
-    integer(psb_ipk_), allocatable  :: bnds(:), locnaggr(:)
-    integer(psb_ipk_) :: myth,nths, kk
-    ! The parallelization makes use of a locaggr(:) array; each thread
-    ! keeps its own version of naggr, and when the loop ends, a prefix is applied
-    ! to locnaggr to determine:
-    ! 1. The total number of aggregaters NAGGR;
-    ! 2. How much should each thread shift its own aggregates
-    ! Part 2 requires to keep track of which thread defined each entry
-    ! of ilaggr(), so that each entry can be adjusted correctly: even
-    ! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
-    ! been set because it is strongly connected to an entry J belonging to a
-    ! different thread. 
-
-    !$omp parallel shared(s_neigh,bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
-    !$omp private(icol,val,myth,kk) 
-    block
-      integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz,nc,i,j,m,nz,ilg,ip,rsz,ip1,nzcnt
-      integer(psb_lpk_) :: itmp
-      !$omp master
-      nths = omp_get_num_threads()
-      allocate(bnds(0:nths),locnaggr(0:nths+1))
-      locnaggr(:) = 0
-      bnds(0) = 1
-      !$omp end master      
-      !$omp barrier
-      myth = omp_get_thread_num()
-      rsz = nr/nths
-      if (myth < mod(nr,nths)) rsz = rsz + 1
-      bnds(myth+1) = rsz
-      !$omp barrier
-      !$omp master
-      do i=1,nths
-        bnds(i) = bnds(i) + bnds(i-1)
-      end do
-      info = 0
-      !$omp end master
-      !$omp barrier
-
-      !$omp do schedule(static) private(disjoint) 
-      do kk=0, nths-1
-        step1: do ii=bnds(kk), bnds(kk+1)-1
-          i = idxs(ii)
-          if (info /= 0) then
-            write(0,*) ' Step1:',kk,ii,i,info
-            cycle step1
-          end if
-          if ((i<1).or.(i>nr)) then
-            !$omp atomic write
-            info=psb_err_internal_error_
-            !$omp end atomic 
-            call psb_errpush(info,name)
-            cycle step1
-            !goto 9999
-          end if
-
-
-          if (ilaggr(i) == -(nr+1)) then 
-            !
-            ! Get the 1-neighbourhood of I 
-            !
-            ip1 = s_neigh%irp(i)
-            nz  = s_neigh%irp(i+1)-ip1
-            !
-            ! If the neighbourhood only contains I, skip it
-            !
-            if (nz ==0) then
-              ilaggr(i) = 0
-              cycle step1
-            end if
-            if ((nz==1).and.(s_neigh%ja(ip1)==i)) then
-              ilaggr(i) = 0
-              cycle step1
-            end if
-
-            nzcnt = count(real(s_neigh%val(ip1:ip1+nz-1)) > 0)
-            icol(1:nzcnt) = pack(s_neigh%ja(ip1:ip1+nz-1),(real(s_neigh%val(ip1:ip1+nz-1)) > 0))
-            disjoint = all(ilaggr(icol(1:nzcnt)) == -(nr+1)) 
-
-            !
-            ! If the whole strongly coupled neighborhood of I is
-            ! as yet unconnected, turn it into the next aggregate.
-            ! Same if ip==0 (in which case, neighborhood only
-            ! contains I even if it does not look like it from matrix)
-            ! The fact that DISJOINT is private and not under lock
-            ! generates a certain un-repeatability, in that between
-            ! computing DISJOINT and assigning, another thread might
-            ! alter the values of ILAGGR.
-            ! However, a certain unrepeatability is already present
-            ! because the sequence of aggregates is computed with a
-            ! different order than in serial mode.
-            ! In any case, even if the enteries of ILAGGR may be
-            ! overwritten, the important thing is that each entry is
-            ! consistent and they generate a correct aggregation map.
-            !
-            if (disjoint) then
-              locnaggr(kk)     = locnaggr(kk) + 1
-              itmp = (bnds(kk)-1+locnaggr(kk)) !be careful about overflow
-              itmp = itmp*nths+kk
-              if (itmp < (bnds(kk)-1+locnaggr(kk))) then
-                !$omp atomic update
-                info = max(12345678,info)
-                !$omp end atomic
-                cycle step1
-              end if
-              !$omp atomic write
-              ilaggr(i) = itmp
-              !$omp end atomic
-              do k=1, nzcnt
-                !$omp atomic write
-                ilaggr(icol(k)) = itmp
-                !$omp end atomic
-              end do
-            end if
-          end if
-        enddo step1
-      end do
-      !$omp end do
-
-      !$omp master
-      naggr = sum(locnaggr(0:nths-1))
-      do i=1,nths
-        locnaggr(i) = locnaggr(i) + locnaggr(i-1)
-      end do
-      do i=nths+1,1,-1
-        locnaggr(i) = locnaggr(i-1)
-      end do
-      locnaggr(0) = 0
-      !write(0,*) 'LNAG ',locnaggr(nths+1)
-      !$omp end master 
-      !$omp barrier
-      !$omp  do schedule(static) 
-      do kk=0, nths-1
-        do ii=bnds(kk), bnds(kk+1)-1
-          if (ilaggr(ii) > 0) then 
-            kp = mod(ilaggr(ii),nths)
-            ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
-          end if
-        end do
-      end do
-      !$omp end do
-    end block
-    !$omp end parallel
-  end block
-  if (info /= 0) then
-    if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
-    info=psb_err_internal_error_
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-
-#else
   icnt = 0
   step1: do ii=1, nr
     i = idxs(ii)
@@ -402,21 +224,16 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     endif
   enddo step1
-#endif  
+  
   if (debug_level >= psb_debug_outer_) then 
     write(debug_unit,*) me,' ',trim(name),&
          & ' Check 1:',count(ilaggr == -(nr+1))
   end if
-  if (do_timings) call psb_toc(idx_soc2_p1)
-  if (do_timings) call psb_tic(idx_soc2_p2)
+
   !
   ! Phase two: join the neighbours
   !
-  !$omp workshare
   tmpaggr = ilaggr
-  !$omp end workshare
-  !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,muij,s_neigh)& 
-  !$omp     private(ii,i,j,k,nz,icol,val,ip,cpling)
   step2: do ii=1,nr
     i = idxs(ii)
 
@@ -442,9 +259,8 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     end if
   end do step2
-  !$omp end parallel do
-  if (do_timings) call psb_toc(idx_soc2_p2)
-  if (do_timings) call psb_tic(idx_soc2_p3)
+
+
   !
   ! Phase three: sweep over leftovers, if any 
   !
@@ -478,8 +294,6 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   end do step3
 
   ! Any leftovers?
-  !$omp parallel do schedule(static) shared(ilaggr,s_neigh,info)& 
-  !$omp     private(ii,i,j,k)
   do i=1, nr
     if (ilaggr(i) <= 0) then
       nz = (s_neigh%irp(i+1)-s_neigh%irp(i))
@@ -491,17 +305,13 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         ! other processes. 
         ilaggr(i) = -(nrglob+nr)
       else
-        !$omp atomic write
         info=psb_err_internal_error_
-        !$omp end atomic
         call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
-        cycle
+        goto 9999
       endif
     end if
   end do
-  !$omp end parallel do
-  if (info /= 0) goto 9999
-  if (do_timings) call psb_toc(idx_soc2_p3)  
+
   if (naggr > ncol) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')

amgprec/impl/aggregator/amg_saggrmat_minnrg_bld.f90

@@ -69,7 +69,6 @@
 !
 !
 ! Arguments:
-!    dol1smoothing - fictitious integer argument, it is not used inside
 !    a          -  type(psb_sspmat_type), input.     
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -105,8 +104,8 @@
 !                  Error code.
 !
 !
-subroutine amg_saggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_saggrmat_minnrg_bld(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_s_inner_mod, amg_protect_name => amg_saggrmat_minnrg_bld
@@ -114,7 +113,6 @@ subroutine amg_saggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)                 :: dol1smoothing
   type(psb_sspmat_type), intent(in)           :: a
   type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
@@ -173,13 +171,6 @@ subroutine amg_saggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 
   filter_mat = (parms%aggr_filter == amg_filter_mat_)
 
-  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
-
-
   !NEEDS TO BE REWORKED !!
   
   ! naggr: number of local aggregates
@@ -309,7 +300,7 @@ subroutine amg_saggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 !!$        endif
 !!$      enddo
 !!$      if (jd == -1) then 
-!!$                write(0,*) name,': Warning: there is no diagonal element', i
+!!$        write(0,*) 'Wrong input: we need the diagonal!!!!', i
 !!$      else
 !!$        acsrf%val(jd)=acsrf%val(jd)-tmp
 !!$      end if

amgprec/impl/aggregator/amg_saggrmat_nosmth_bld.f90

@@ -94,11 +94,10 @@
 !               
 !    info       -  integer, output.
 !                  Error code.
-!    dol1smoothing - optional, this is here just for interfacing reasons. It is not used by the
-!                    code
 !
-subroutine amg_saggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+!
+subroutine amg_saggrmat_nosmth_bld(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_s_inner_mod, amg_protect_name => amg_saggrmat_nosmth_bld
@@ -106,7 +105,6 @@ subroutine amg_saggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)              :: dol1smoothing 
   type(psb_sspmat_type), intent(in)        :: a
   type(psb_desc_type), intent(inout)         :: desc_a
   integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
@@ -139,12 +137,6 @@ subroutine amg_saggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 
   ctxt = desc_a%get_context()
   call psb_info(ctxt, 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()

amgprec/impl/aggregator/amg_saggrmat_smth_bld.f90

@@ -69,8 +69,6 @@
 !
 !
 ! Arguments:
-!    dol1smooth -  Integer taking the type of smoother that has to be used
-!                  on the tentative prolongator
 !    a          -  type(psb_sspmat_type), input.     
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -104,8 +102,8 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_saggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_saggrmat_smth_bld(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_s_inner_mod, amg_protect_name => amg_saggrmat_smth_bld
@@ -114,7 +112,6 @@ subroutine amg_saggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)            :: dol1smoothing
   type(psb_sspmat_type), intent(in)      :: a
   type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
@@ -135,7 +132,7 @@ subroutine amg_saggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   type(psb_s_coo_sparse_mat) :: coo_prol, coo_restr
   type(psb_s_csr_sparse_mat) :: acsr1,  acsrf, csr_prol, acsr
   real(psb_spk_), allocatable :: adiag(:)
-  real(psb_spk_), allocatable :: arwsum(:),l1rwsum(:)
+  real(psb_spk_), allocatable :: arwsum(:)
   integer(psb_ipk_)  :: ierr(5)
   logical            :: filter_mat
   integer(psb_ipk_)            :: debug_level, debug_unit, err_act
@@ -144,7 +141,6 @@ subroutine amg_saggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   logical, parameter :: debug_new=.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
   integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1
 
@@ -177,9 +173,6 @@ subroutine amg_saggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   if ((do_timings).and.(idx_ptap==-1)) &
        & idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld  ")
 
-  ! check if we have to use Jacobi or l1-Jacobi to smooth the tentative prolongator
-  if (dol1smoothing.eq.amg_l1_smooth_prol_) do_l1correction=.true.
-
 
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
@@ -207,24 +200,6 @@ subroutine amg_saggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
   if (info == psb_success_) call a%cp_to(acsr)
-  !
-  ! Do the l1-correction on the diagonal if it is requested
-  !
-  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}|
-    !$OMP parallel do private(i) schedule(static)
-    do i=1,size(adiag)
-      adiag(i) = adiag(i) + l1rwsum(i) - abs(adiag(i))
-    end do
-    !$OMP end parallel do
-  end if
-
 
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
@@ -255,7 +230,6 @@ subroutine amg_saggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 
       enddo
       if (jd == -1) then 
-        ! if (.not.do_l1correction) 
         write(0,*) 'Wrong input: we need the diagonal!!!!', i
       else
         acsrf%val(jd)=acsrf%val(jd)-tmp
@@ -278,10 +252,6 @@ subroutine amg_saggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   !$OMP end parallel do 
   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
-    !
     if (parms%aggr_eig == amg_max_norm_) then 
       allocate(arwsum(nrow))
       call acsr%arwsum(arwsum)      
@@ -289,6 +259,7 @@ subroutine amg_saggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
       call psb_amx(ctxt,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_')
@@ -351,7 +322,6 @@ subroutine amg_saggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '
-  if (allocated(l1rwsum)) deallocate(l1rwsum)
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/amg_z_dec_aggregator_mat_bld.f90

@@ -177,24 +177,23 @@ subroutine  amg_z_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
   select case (parms%aggr_prol)
   case (amg_no_smooth_) 
 
-    call amg_zaggrmat_nosmth_bld(parms%aggr_prol,a,desc_a,ilaggr,&
-            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_zaggrmat_nosmth_bld(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_) 
 
-    call amg_zaggrmat_smth_bld(parms%aggr_prol,a,desc_a,&
-            ilaggr,nlaggr,parms,ac,desc_ac,op_prol,&
-            op_restr,t_prol,info)
+    call amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr, &
+         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
 !!$  case(amg_biz_prol_) 
 !!$
 !!$    call amg_zaggrmat_biz_bld(a,desc_a,ilaggr,nlaggr, &
 !!$         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
-  
+
   case(amg_min_energy_) 
 
-    call amg_zaggrmat_minnrg_bld(parms%aggr_prol,a,desc_a,ilaggr,&
-            nlaggr,parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+    call amg_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, &
+         & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
 
   case default
     info = psb_err_internal_error_

amgprec/impl/aggregator/amg_z_ptap_bld.f90

@@ -76,7 +76,7 @@ subroutine amg_z_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   integer(psb_ipk_) :: nrow, ncol, nrl, nzl, ip, nzt, i, k
   integer(psb_lpk_) ::  nrsave, ncsave, nzsave, nza
   logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.  
-  integer(psb_ipk_), save :: idx_spspmm=-1, idx_cpytrans1=-1, idx_cpytrans2=-1
+  integer(psb_ipk_), save :: idx_spspmm=-1
 
   name='amg_ptap_bld'
   if(psb_get_errstatus().ne.0) return 
@@ -93,11 +93,7 @@ subroutine amg_z_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ncol  = desc_a%get_local_cols()
 
   if ((do_timings).and.(idx_spspmm==-1)) &
-       & idx_spspmm = psb_get_timer_idx("PTAP_BLD: par_spspmm")
-  if ((do_timings).and.(idx_cpytrans1==-1)) &
-       & idx_cpytrans1 = psb_get_timer_idx("PTAP_BLD: cpy&trans1")
-  if ((do_timings).and.(idx_cpytrans2==-1)) &
-       & idx_cpytrans2 = psb_get_timer_idx("PTAP_BLD: cpy&trans2")
+       & idx_spspmm = psb_get_timer_idx("SPMM_BLD: par_spspmm")
 
   naggr   = nlaggr(me+1)
   ntaggr  = sum(nlaggr)
@@ -132,7 +128,6 @@ subroutine amg_z_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
   ! Ok first product done.
 
   if (present(desc_ax)) then
-    if (do_timings) call psb_tic(idx_cpytrans1)
     block 
       call coo_prol%cp_to_coo(coo_restr,info)
       call coo_restr%set_ncols(desc_ac%get_local_cols())
@@ -142,7 +137,7 @@ subroutine amg_z_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
       call coo_restr%set_ncols(desc_ax%get_local_cols())
     end block
     call csr_restr%cp_from_coo(coo_restr,info)
-    if (do_timings) call psb_toc(idx_cpytrans1)
+
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999
@@ -172,28 +167,27 @@ subroutine amg_z_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
 
     call coo_restr%transp()
     nzl = coo_restr%get_nzeros()
-    nrl = desc_ac%get_local_rows()
-    call coo_restr%fix(info)
-    i=coo_restr%get_nzeros()
+    nrl = desc_ac%get_local_rows() 
+    i=0
     !
     ! Only keep local rows
     !
-    search: do k=i,1,-1
-      if (coo_restr%ia(k) <= nrl) then
-        call coo_restr%set_nzeros(k)
-        exit search
+    do k=1, nzl
+      if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then
+        i = i+1
+        coo_restr%val(i) = coo_restr%val(k)
+        coo_restr%ia(i)  = coo_restr%ia(k)
+        coo_restr%ja(i)  = coo_restr%ja(k)
       end if
-    end do search
-
+    end do
+    call coo_restr%set_nzeros(i)
+    call coo_restr%fix(info) 
     nzl  = coo_restr%get_nzeros()
     call coo_restr%set_nrows(desc_ac%get_local_rows())
     call coo_restr%set_ncols(desc_a%get_local_cols())
     if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
-    if (do_timings) call psb_tic(idx_cpytrans2)
-        
     call csr_restr%cp_from_coo(coo_restr,info)
 
-    if (do_timings) call psb_toc(idx_cpytrans2)
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
       goto 9999

amgprec/impl/aggregator/amg_z_soc1_map_bld.f90

@@ -72,9 +72,7 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   use psb_base_mod
   use amg_base_prec_type
   use amg_z_inner_mod
-#if defined(OPENMP)
-  use omp_lib
-#endif
+
   implicit none
 
   ! Arguments
@@ -87,7 +85,7 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_), intent(out)               :: info
 
   ! Local variables
-  integer(psb_ipk_), allocatable :: neigh(:), irow(:), icol(:),&
+  integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:),&
        & ideg(:), idxs(:)
   integer(psb_lpk_), allocatable :: tmpaggr(:)
   complex(psb_dpk_), allocatable  :: val(:), diag(:)
@@ -101,9 +99,6 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_)   :: nrow, ncol, n_ne
   integer(psb_lpk_)   :: nrglob
   character(len=20)   :: name, ch_err
-  integer(psb_ipk_), save :: idx_soc1_p1=-1, idx_soc1_p2=-1, idx_soc1_p3=-1
-  integer(psb_ipk_), save :: idx_soc1_p0=-1
-  logical, parameter      :: do_timings=.true.
 
   info=psb_success_
   name = 'amg_soc1_map_bld'
@@ -119,14 +114,6 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nrow   = desc_a%get_local_rows()
   ncol   = desc_a%get_local_cols()
   nrglob = desc_a%get_global_rows()
-  if ((do_timings).and.(idx_soc1_p0==-1))       &
-       & idx_soc1_p0 = psb_get_timer_idx("SOC1_MAP: phase0")
-  if ((do_timings).and.(idx_soc1_p1==-1))       &
-       & idx_soc1_p1 = psb_get_timer_idx("SOC1_MAP: phase1")
-  if ((do_timings).and.(idx_soc1_p2==-1))       &
-       & idx_soc1_p2 = psb_get_timer_idx("SOC1_MAP: phase2")
-  if ((do_timings).and.(idx_soc1_p3==-1))       &
-       & idx_soc1_p3 = psb_get_timer_idx("SOC1_MAP: phase3")
 
   nr = a%get_nrows()
   nc = a%get_ncols()
@@ -146,205 +133,41 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
     goto 9999
   end if
 
-  if (do_timings) call psb_tic(idx_soc1_p0)
   call a%cp_to(acsr)
-  if (do_timings) call psb_toc(idx_soc1_p0)
   if (clean_zeros) call acsr%clean_zeros(info)
   if (iorder == amg_aggr_ord_nat_) then 
-    !$omp parallel do private(i) schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
-      idxs(i)   = i
+      idxs(i)   = i 
     end do
-    !$omp end parallel do 
-  else
-    !$omp parallel do private(i) schedule(static)
+  else 
     do i=1, nr
       ilaggr(i) = -(nr+1)
       ideg(i)   = acsr%irp(i+1) - acsr%irp(i)
     end do
-    !$omp end parallel do 
     call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
   end if
-  if (do_timings) call psb_tic(idx_soc1_p1)
+
 
   !
   ! Phase one: Start with disjoint groups.
   ! 
   naggr = 0
-#if defined(OPENMP)
-  block
-    integer(psb_ipk_), allocatable  :: bnds(:), locnaggr(:)
-    integer(psb_ipk_) :: myth,nths, kk
-    ! The parallelization makes use of a locaggr(:) array; each thread
-    ! keeps its own version of naggr, and when the loop ends, a prefix is applied
-    ! to locnaggr to determine:
-    ! 1. The total number of aggregaters NAGGR;
-    ! 2. How much should each thread shift its own aggregates
-    ! Part 2 requires to keep track of which thread defined each entry
-    ! of ilaggr(), so that each entry can be adjusted correctly: even
-    ! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
-    ! been set because it is strongly connected to an entry J belonging to a
-    ! different thread. 
-
-    !$omp parallel shared(bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
-    !$omp private(icol,val,myth,kk) 
-    block
-      integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz, nc, i,j,m, nz, ilg,  ip, rsz
-      integer(psb_lpk_) :: itmp
-      !$omp master
-      nths = omp_get_num_threads()
-      allocate(bnds(0:nths),locnaggr(0:nths+1))
-      locnaggr(:) = 0
-      bnds(0) = 1
-      !$omp end master      
-      !$omp barrier
-      myth = omp_get_thread_num()
-      rsz = nr/nths
-      if (myth < mod(nr,nths)) rsz = rsz + 1
-      bnds(myth+1) = rsz
-      !$omp barrier
-      !$omp master
-      do i=1,nths
-        bnds(i) = bnds(i) + bnds(i-1)
-      end do
-      info = 0
-      !$omp end master
-      !$omp barrier
-      
-      !$omp do schedule(static) private(disjoint) 
-      do kk=0, nths-1
-        step1: do ii=bnds(kk), bnds(kk+1)-1
-          i = idxs(ii)          
-          if (info /= 0) cycle step1
-          if ((i<1).or.(i>nr)) then
-            !$omp atomic write
-            info=psb_err_internal_error_
-            !$omp end atomic 
-            call psb_errpush(info,name)
-            cycle step1
-            !goto 9999
-          end if
-            
-          if (ilaggr(i) == -(nr+1)) then
-            nz         = (acsr%irp(i+1)-acsr%irp(i))
-            if ((nz<0).or.(nz>size(icol))) then
-              !$omp atomic write
-              info=psb_err_internal_error_
-              !$omp end atomic 
-              call psb_errpush(info,name)
-              cycle step1
-              !goto 9999
-            end if
-
-            icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
-            val(1:nz)  = acsr%val(acsr%irp(i):acsr%irp(i+1)-1) 
-
-            !
-            ! Build the set of all strongly coupled nodes 
-            !
-            ip = 0
-            do k=1, nz
-              j   = icol(k)
-              ! If any of the neighbours is already assigned,
-              ! we will not reset. 
-              if (j>nr) cycle step1
-              if (ilaggr(j) > 0) cycle step1
-              if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.zzero)) then
-                ip = ip + 1
-                icol(ip) = icol(k)
-              end if
-            enddo
-            
-            !
-            ! If the whole strongly coupled neighborhood of I is
-            ! as yet unconnected, turn it into the next aggregate.
-            ! Same if ip==0 (in which case, neighborhood only
-            ! contains I even if it does not look like it from matrix)
-            ! The fact that DISJOINT is private and not under lock
-            ! generates a certain un-repeatability, in that between
-            ! computing DISJOINT and assigning, another thread might
-            ! alter the values of ILAGGR.
-            ! However, a certain unrepeatability is already present
-            ! because the sequence of aggregates is computed with a
-            ! different order than in serial mode.
-            ! In any case, even if the enteries of ILAGGR may be
-            ! overwritten, the important thing is that each entry is
-            ! consistent and they generate a correct aggregation map.
-            !
-            disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
-            if (disjoint) then
-              locnaggr(kk)     = locnaggr(kk) + 1
-              itmp = (bnds(kk)-1+locnaggr(kk)) !be careful about overflow
-              itmp = itmp*nths+kk
-              if (itmp < (bnds(kk)-1+locnaggr(kk))) then
-                !$omp atomic update
-                info = max(12345678,info)
-                !$omp end atomic
-                cycle step1
-              end if
-              !$omp atomic write
-              ilaggr(i) = itmp
-              !$omp end atomic
-              do k=1, ip
-                !$omp atomic write
-                ilaggr(icol(k)) = itmp
-                !$omp end atomic
-              end do
-            end if
-          end if
-        enddo step1
-      end do
-      !$omp end do
-
-      !$omp master
-      naggr = sum(locnaggr(0:nths-1))
-      do i=1,nths
-        locnaggr(i) = locnaggr(i) + locnaggr(i-1)
-      end do
-      do i=nths+1,1,-1
-        locnaggr(i) = locnaggr(i-1)
-      end do
-      locnaggr(0) = 0
-      !$omp end master 
-      !$omp barrier
-      !$omp  do schedule(static) 
-      do kk=0, nths-1
-        do ii=bnds(kk), bnds(kk+1)-1
-          if (ilaggr(ii) > 0) then 
-            kp = mod(ilaggr(ii),nths)
-            ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
-          end if
-        end do
-      end do
-      !$omp end do
-    end block
-    !$omp end parallel
-  end block
-  if (info /= 0) then
-    if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
-    info=psb_err_internal_error_
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-#else
+  icnt = 0
   step1: do ii=1, nr
-    if (info /= 0) cycle
     i = idxs(ii)
     if ((i<1).or.(i>nr)) then
       info=psb_err_internal_error_
       call psb_errpush(info,name)
-      cycle step1
-      !goto 9999
+      goto 9999
     end if
-
+    
     if (ilaggr(i) == -(nr+1)) then
       nz         = (acsr%irp(i+1)-acsr%irp(i))
       if ((nz<0).or.(nz>size(icol))) then
         info=psb_err_internal_error_
         call psb_errpush(info,name)
-        cycle step1
-        !goto 9999
+        goto 9999
       end if
 
       icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
@@ -353,11 +176,11 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       !
       ! Build the set of all strongly coupled nodes 
       !
-      ip = 0
+      ip = 0 
       do k=1, nz
         j   = icol(k)
         if ((1<=j).and.(j<=nr)) then 
-          if ((abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))).and.(diag(i).ne.zzero)) then
+          if (abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))) then
             ip = ip + 1
             icol(ip) = icol(k)
           end if
@@ -371,7 +194,8 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       ! contains I even if it does not look like it from matrix)
       !
       disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
-      if (disjoint) then       
+      if (disjoint) then 
+        icnt      = icnt + 1 
         naggr     = naggr + 1
         do k=1, ip
           ilaggr(icol(k)) = naggr
@@ -380,22 +204,16 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     endif
   enddo step1
-#endif
+  
   if (debug_level >= psb_debug_outer_) then 
     write(debug_unit,*) me,' ',trim(name),&
-         & ' Check   1:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
-         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
+         & ' Check 1:',count(ilaggr == -(nr+1))
   end if
-  if (do_timings) call psb_toc(idx_soc1_p1)
-  if (do_timings) call psb_tic(idx_soc1_p2)
+
   !
   ! Phase two: join the neighbours
   !
-  !$omp workshare
   tmpaggr = ilaggr
-  !$omp end workshare
-  !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,theta)& 
-  !$omp     private(ii,i,j,k,nz,icol,val,ip,cpling)
   step2: do ii=1,nr
     i = idxs(ii)
 
@@ -426,15 +244,8 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     end if
   end do step2
-  !$omp end parallel do
-  if (do_timings) call psb_toc(idx_soc1_p2)
-  if (debug_level >= psb_debug_outer_) then 
-    write(debug_unit,*) me,' ',trim(name),&
-         & ' Check 1.5:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
-         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
-  end if
 
-  if (do_timings) call psb_tic(idx_soc1_p3)
+
   !
   ! Phase three: sweep over leftovers, if any 
   !
@@ -463,6 +274,7 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         end if
       enddo
       if (ip > 0) then
+        icnt      = icnt + 1 
         naggr     = naggr + 1
         ilaggr(i) = naggr
         do k=1, ip
@@ -480,10 +292,7 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   end do step3
 
   ! Any leftovers?
-  !$omp parallel do schedule(static) shared(ilaggr,info)& 
-  !$omp     private(ii,i,j,k,nz,icol,val,ip)
   do i=1, nr
-    if (info /= 0) cycle
     if (ilaggr(i) < 0) then
       nz = (acsr%irp(i+1)-acsr%irp(i))
       if (nz == 1) then
@@ -494,18 +303,15 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         ! other processes. 
         ilaggr(i) = -(nrglob+nr)
       else
-        !$omp atomic write
         info=psb_err_internal_error_
-        !$omp end atomic
         call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
-        cycle 
+        goto 9999
       endif
     end if
   end do
-  !$omp end parallel do
-  if (info /= 0) goto 9999
-  if (do_timings) call psb_toc(idx_soc1_p3)
+
   if (naggr > ncol) then 
+    !write(0,*) name,'Error : naggr > ncol',naggr,ncol
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')
     goto 9999
@@ -530,13 +336,9 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nlaggr(:) = 0
   nlaggr(me+1) = naggr
   call psb_sum(ctxt,nlaggr(1:np))
-  if (debug_level >= psb_debug_outer_) then 
-    write(debug_unit,*) me,' ',trim(name),&
-         & ' Check   2:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
-         & count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
-  end if
 
   call acsr%free()
+
   call psb_erractionrestore(err_act)
   return
 
@@ -545,3 +347,4 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   return
 
 end subroutine amg_z_soc1_map_bld
+

amgprec/impl/aggregator/amg_z_soc2_map_bld.f90

@@ -68,12 +68,9 @@
 !
 subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
 
-  use psb_base_mod 
+  use psb_base_mod
   use amg_base_prec_type
   use amg_z_inner_mod
-#if defined(OPENMP)
-  use omp_lib
-#endif
 
   implicit none
 
@@ -102,9 +99,6 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   integer(psb_ipk_) :: np, me
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
-  integer(psb_ipk_), save :: idx_soc2_p1=-1, idx_soc2_p2=-1, idx_soc2_p3=-1
-  integer(psb_ipk_), save :: idx_soc2_p0=-1
-  logical, parameter      :: do_timings=.true.
 
   info=psb_success_
   name = 'amg_soc2_map_bld'
@@ -120,14 +114,6 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   nrow   = desc_a%get_local_rows()
   ncol   = desc_a%get_local_cols()
   nrglob = desc_a%get_global_rows()
-  if ((do_timings).and.(idx_soc2_p0==-1))       &
-       & idx_soc2_p0 = psb_get_timer_idx("SOC2_MAP: phase0")
-  if ((do_timings).and.(idx_soc2_p1==-1))       &
-       & idx_soc2_p1 = psb_get_timer_idx("SOC2_MAP: phase1")
-  if ((do_timings).and.(idx_soc2_p2==-1))       &
-       & idx_soc2_p2 = psb_get_timer_idx("SOC2_MAP: phase2")
-  if ((do_timings).and.(idx_soc2_p3==-1))       &
-       & idx_soc2_p3 = psb_get_timer_idx("SOC2_MAP: phase3")
 
   nr = a%get_nrows()
   nc = a%get_ncols()
@@ -139,7 +125,6 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
     goto 9999
   end if
 
-  if (do_timings) call psb_tic(idx_soc2_p0)
   diag = a%get_diag(info)
   if(info /= psb_success_) then
     info=psb_err_from_subroutine_
@@ -152,218 +137,55 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   ! 
   call a%cp_to(muij)
   if (clean_zeros) call muij%clean_zeros(info)
-  !$omp parallel do private(i,j,k) shared(nr,diag,muij) schedule(static)
   do i=1, nr
     do k=muij%irp(i),muij%irp(i+1)-1
       j = muij%ja(k)
       if (j<= nr) muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
     end do
   end do
-  !$omp end parallel do 
+
   !
   ! Compute the 1-neigbour; mark strong links with +1, weak links with -1
   !
   call s_neigh_coo%allocate(nr,nr,muij%get_nzeros())
-  !$omp parallel do private(i,j,k) shared(nr,diag,muij) schedule(static)
+  ip = 0 
   do i=1, nr
     do k=muij%irp(i),muij%irp(i+1)-1
       j = muij%ja(k)
-      s_neigh_coo%ia(k)  = i
-      s_neigh_coo%ja(k)  = j
       if (j<=nr) then 
+        ip = ip + 1
+        s_neigh_coo%ia(ip)  = i
+        s_neigh_coo%ja(ip)  = j
         if (real(muij%val(k)) >= theta) then 
-          s_neigh_coo%val(k) = done
+          s_neigh_coo%val(ip) = done
         else
-          s_neigh_coo%val(k) = -done
+          s_neigh_coo%val(ip) = -done
         end if
-      else
-        s_neigh_coo%val(k) = -done        
       end if
     end do
   end do
-  !$omp end parallel do
   !write(*,*) 'S_NEIGH: ',nr,ip
-  call s_neigh_coo%set_nzeros(muij%get_nzeros())
+  call s_neigh_coo%set_nzeros(ip)
   call s_neigh%mv_from_coo(s_neigh_coo,info)
 
-  if (iorder == amg_aggr_ord_nat_) then
-    
-    !$omp parallel do private(i) shared(ilaggr,idxs) schedule(static)
+  if (iorder == amg_aggr_ord_nat_) then 
     do i=1, nr
       ilaggr(i) = -(nr+1)
       idxs(i)   = i 
     end do
-    !$omp end parallel do 
   else 
-    !$omp parallel do private(i) shared(ilaggr,idxs,muij)  schedule(static)
     do i=1, nr
       ilaggr(i) = -(nr+1)
       ideg(i)   = muij%irp(i+1) - muij%irp(i)
     end do
-    !$omp end parallel do
     call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
   end if
 
-  if (do_timings) call psb_toc(idx_soc2_p0)
-  if (do_timings) call psb_tic(idx_soc2_p1)
 
   !
   ! Phase one: Start with disjoint groups.
   ! 
   naggr = 0
-#if defined(OPENMP)
-  block
-    integer(psb_ipk_), allocatable  :: bnds(:), locnaggr(:)
-    integer(psb_ipk_) :: myth,nths, kk
-    ! The parallelization makes use of a locaggr(:) array; each thread
-    ! keeps its own version of naggr, and when the loop ends, a prefix is applied
-    ! to locnaggr to determine:
-    ! 1. The total number of aggregaters NAGGR;
-    ! 2. How much should each thread shift its own aggregates
-    ! Part 2 requires to keep track of which thread defined each entry
-    ! of ilaggr(), so that each entry can be adjusted correctly: even
-    ! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
-    ! been set because it is strongly connected to an entry J belonging to a
-    ! different thread. 
-
-    !$omp parallel shared(s_neigh,bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
-    !$omp private(icol,val,myth,kk) 
-    block
-      integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz,nc,i,j,m,nz,ilg,ip,rsz,ip1,nzcnt
-      integer(psb_lpk_) :: itmp
-      !$omp master
-      nths = omp_get_num_threads()
-      allocate(bnds(0:nths),locnaggr(0:nths+1))
-      locnaggr(:) = 0
-      bnds(0) = 1
-      !$omp end master      
-      !$omp barrier
-      myth = omp_get_thread_num()
-      rsz = nr/nths
-      if (myth < mod(nr,nths)) rsz = rsz + 1
-      bnds(myth+1) = rsz
-      !$omp barrier
-      !$omp master
-      do i=1,nths
-        bnds(i) = bnds(i) + bnds(i-1)
-      end do
-      info = 0
-      !$omp end master
-      !$omp barrier
-
-      !$omp do schedule(static) private(disjoint) 
-      do kk=0, nths-1
-        step1: do ii=bnds(kk), bnds(kk+1)-1
-          i = idxs(ii)
-          if (info /= 0) then
-            write(0,*) ' Step1:',kk,ii,i,info
-            cycle step1
-          end if
-          if ((i<1).or.(i>nr)) then
-            !$omp atomic write
-            info=psb_err_internal_error_
-            !$omp end atomic 
-            call psb_errpush(info,name)
-            cycle step1
-            !goto 9999
-          end if
-
-
-          if (ilaggr(i) == -(nr+1)) then 
-            !
-            ! Get the 1-neighbourhood of I 
-            !
-            ip1 = s_neigh%irp(i)
-            nz  = s_neigh%irp(i+1)-ip1
-            !
-            ! If the neighbourhood only contains I, skip it
-            !
-            if (nz ==0) then
-              ilaggr(i) = 0
-              cycle step1
-            end if
-            if ((nz==1).and.(s_neigh%ja(ip1)==i)) then
-              ilaggr(i) = 0
-              cycle step1
-            end if
-
-            nzcnt = count(real(s_neigh%val(ip1:ip1+nz-1)) > 0)
-            icol(1:nzcnt) = pack(s_neigh%ja(ip1:ip1+nz-1),(real(s_neigh%val(ip1:ip1+nz-1)) > 0))
-            disjoint = all(ilaggr(icol(1:nzcnt)) == -(nr+1)) 
-
-            !
-            ! If the whole strongly coupled neighborhood of I is
-            ! as yet unconnected, turn it into the next aggregate.
-            ! Same if ip==0 (in which case, neighborhood only
-            ! contains I even if it does not look like it from matrix)
-            ! The fact that DISJOINT is private and not under lock
-            ! generates a certain un-repeatability, in that between
-            ! computing DISJOINT and assigning, another thread might
-            ! alter the values of ILAGGR.
-            ! However, a certain unrepeatability is already present
-            ! because the sequence of aggregates is computed with a
-            ! different order than in serial mode.
-            ! In any case, even if the enteries of ILAGGR may be
-            ! overwritten, the important thing is that each entry is
-            ! consistent and they generate a correct aggregation map.
-            !
-            if (disjoint) then
-              locnaggr(kk)     = locnaggr(kk) + 1
-              itmp = (bnds(kk)-1+locnaggr(kk)) !be careful about overflow
-              itmp = itmp*nths+kk
-              if (itmp < (bnds(kk)-1+locnaggr(kk))) then
-                !$omp atomic update
-                info = max(12345678,info)
-                !$omp end atomic
-                cycle step1
-              end if
-              !$omp atomic write
-              ilaggr(i) = itmp
-              !$omp end atomic
-              do k=1, nzcnt
-                !$omp atomic write
-                ilaggr(icol(k)) = itmp
-                !$omp end atomic
-              end do
-            end if
-          end if
-        enddo step1
-      end do
-      !$omp end do
-
-      !$omp master
-      naggr = sum(locnaggr(0:nths-1))
-      do i=1,nths
-        locnaggr(i) = locnaggr(i) + locnaggr(i-1)
-      end do
-      do i=nths+1,1,-1
-        locnaggr(i) = locnaggr(i-1)
-      end do
-      locnaggr(0) = 0
-      !write(0,*) 'LNAG ',locnaggr(nths+1)
-      !$omp end master 
-      !$omp barrier
-      !$omp  do schedule(static) 
-      do kk=0, nths-1
-        do ii=bnds(kk), bnds(kk+1)-1
-          if (ilaggr(ii) > 0) then 
-            kp = mod(ilaggr(ii),nths)
-            ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
-          end if
-        end do
-      end do
-      !$omp end do
-    end block
-    !$omp end parallel
-  end block
-  if (info /= 0) then
-    if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
-    info=psb_err_internal_error_
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-
-#else
   icnt = 0
   step1: do ii=1, nr
     i = idxs(ii)
@@ -402,21 +224,16 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     endif
   enddo step1
-#endif  
+  
   if (debug_level >= psb_debug_outer_) then 
     write(debug_unit,*) me,' ',trim(name),&
          & ' Check 1:',count(ilaggr == -(nr+1))
   end if
-  if (do_timings) call psb_toc(idx_soc2_p1)
-  if (do_timings) call psb_tic(idx_soc2_p2)
+
   !
   ! Phase two: join the neighbours
   !
-  !$omp workshare
   tmpaggr = ilaggr
-  !$omp end workshare
-  !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,muij,s_neigh)& 
-  !$omp     private(ii,i,j,k,nz,icol,val,ip,cpling)
   step2: do ii=1,nr
     i = idxs(ii)
 
@@ -442,9 +259,8 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
       end if
     end if
   end do step2
-  !$omp end parallel do
-  if (do_timings) call psb_toc(idx_soc2_p2)
-  if (do_timings) call psb_tic(idx_soc2_p3)
+
+
   !
   ! Phase three: sweep over leftovers, if any 
   !
@@ -478,8 +294,6 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
   end do step3
 
   ! Any leftovers?
-  !$omp parallel do schedule(static) shared(ilaggr,s_neigh,info)& 
-  !$omp     private(ii,i,j,k)
   do i=1, nr
     if (ilaggr(i) <= 0) then
       nz = (s_neigh%irp(i+1)-s_neigh%irp(i))
@@ -491,17 +305,13 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
         ! other processes. 
         ilaggr(i) = -(nrglob+nr)
       else
-        !$omp atomic write
         info=psb_err_internal_error_
-        !$omp end atomic
         call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
-        cycle
+        goto 9999
       endif
     end if
   end do
-  !$omp end parallel do
-  if (info /= 0) goto 9999
-  if (do_timings) call psb_toc(idx_soc2_p3)  
+
   if (naggr > ncol) then 
     info=psb_err_internal_error_
     call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')

amgprec/impl/aggregator/amg_zaggrmat_minnrg_bld.f90

@@ -69,7 +69,6 @@
 !
 !
 ! Arguments:
-!    dol1smoothing - fictitious integer argument, it is not used inside
 !    a          -  type(psb_zspmat_type), input.     
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -105,8 +104,8 @@
 !                  Error code.
 !
 !
-subroutine amg_zaggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_zaggrmat_minnrg_bld(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_z_inner_mod, amg_protect_name => amg_zaggrmat_minnrg_bld
@@ -114,7 +113,6 @@ subroutine amg_zaggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)                 :: dol1smoothing
   type(psb_zspmat_type), intent(in)           :: a
   type(psb_desc_type), intent(inout)            :: desc_a
   integer(psb_lpk_), intent(inout)              :: ilaggr(:), nlaggr(:)
@@ -173,13 +171,6 @@ subroutine amg_zaggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 
   filter_mat = (parms%aggr_filter == amg_filter_mat_)
 
-  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
-
-
   !NEEDS TO BE REWORKED !!
   
   ! naggr: number of local aggregates
@@ -309,7 +300,7 @@ subroutine amg_zaggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 !!$        endif
 !!$      enddo
 !!$      if (jd == -1) then 
-!!$                write(0,*) name,': Warning: there is no diagonal element', i
+!!$        write(0,*) 'Wrong input: we need the diagonal!!!!', i
 !!$      else
 !!$        acsrf%val(jd)=acsrf%val(jd)-tmp
 !!$      end if

amgprec/impl/aggregator/amg_zaggrmat_nosmth_bld.f90

@@ -94,11 +94,10 @@
 !               
 !    info       -  integer, output.
 !                  Error code.
-!    dol1smoothing - optional, this is here just for interfacing reasons. It is not used by the
-!                    code
 !
-subroutine amg_zaggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+!
+subroutine amg_zaggrmat_nosmth_bld(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_z_inner_mod, amg_protect_name => amg_zaggrmat_nosmth_bld
@@ -106,7 +105,6 @@ subroutine amg_zaggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)              :: dol1smoothing 
   type(psb_zspmat_type), intent(in)        :: a
   type(psb_desc_type), intent(inout)         :: desc_a
   integer(psb_lpk_), intent(inout)           :: ilaggr(:), nlaggr(:)
@@ -139,12 +137,6 @@ subroutine amg_zaggrmat_nosmth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 
   ctxt = desc_a%get_context()
   call psb_info(ctxt, 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()

amgprec/impl/aggregator/amg_zaggrmat_smth_bld.f90

@@ -69,8 +69,6 @@
 !
 !
 ! Arguments:
-!    dol1smooth -  Integer taking the type of smoother that has to be used
-!                  on the tentative prolongator
 !    a          -  type(psb_zspmat_type), input.     
 !                  The sparse matrix structure containing the local part of
 !                  the fine-level matrix.
@@ -104,8 +102,8 @@
 !    info       -  integer, output.
 !                  Error code.
 !
-subroutine amg_zaggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
-                parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
+subroutine amg_zaggrmat_smth_bld(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_z_inner_mod, amg_protect_name => amg_zaggrmat_smth_bld
@@ -114,7 +112,6 @@ subroutine amg_zaggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   implicit none
 
   ! Arguments
-  integer(psb_ipk_), intent(in)            :: dol1smoothing
   type(psb_zspmat_type), intent(in)      :: a
   type(psb_desc_type), intent(inout)       :: desc_a
   integer(psb_lpk_), intent(inout)         :: ilaggr(:), nlaggr(:)
@@ -135,7 +132,7 @@ subroutine amg_zaggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   type(psb_z_coo_sparse_mat) :: coo_prol, coo_restr
   type(psb_z_csr_sparse_mat) :: acsr1,  acsrf, csr_prol, acsr
   complex(psb_dpk_), allocatable :: adiag(:)
-  real(psb_dpk_), allocatable :: arwsum(:),l1rwsum(:)
+  real(psb_dpk_), allocatable :: arwsum(:)
   integer(psb_ipk_)  :: ierr(5)
   logical            :: filter_mat
   integer(psb_ipk_)            :: debug_level, debug_unit, err_act
@@ -144,7 +141,6 @@ subroutine amg_zaggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   logical, parameter :: debug_new=.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
   integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1
 
@@ -177,9 +173,6 @@ subroutine amg_zaggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   if ((do_timings).and.(idx_ptap==-1)) &
        & idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld  ")
 
-  ! check if we have to use Jacobi or l1-Jacobi to smooth the tentative prolongator
-  if (dol1smoothing.eq.amg_l1_smooth_prol_) do_l1correction=.true.
-
 
   nglob = desc_a%get_global_rows()
   nrow  = desc_a%get_local_rows()
@@ -207,24 +200,6 @@ subroutine amg_zaggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   if (info == psb_success_) &
        & call psb_halo(adiag,desc_a,info)
   if (info == psb_success_) call a%cp_to(acsr)
-  !
-  ! Do the l1-correction on the diagonal if it is requested
-  !
-  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}|
-    !$OMP parallel do private(i) schedule(static)
-    do i=1,size(adiag)
-      adiag(i) = adiag(i) + l1rwsum(i) - abs(adiag(i))
-    end do
-    !$OMP end parallel do
-  end if
-
 
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
@@ -255,7 +230,6 @@ subroutine amg_zaggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
 
       enddo
       if (jd == -1) then 
-        ! if (.not.do_l1correction) 
         write(0,*) 'Wrong input: we need the diagonal!!!!', i
       else
         acsrf%val(jd)=acsrf%val(jd)-tmp
@@ -278,10 +252,6 @@ subroutine amg_zaggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   !$OMP end parallel do 
   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
-    !
     if (parms%aggr_eig == amg_max_norm_) then 
       allocate(arwsum(nrow))
       call acsr%arwsum(arwsum)      
@@ -289,6 +259,7 @@ subroutine amg_zaggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
       call psb_amx(ctxt,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_')
@@ -351,7 +322,6 @@ subroutine amg_zaggrmat_smth_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   if (debug_level >= psb_debug_outer_) &
        & write(debug_unit,*) me,' ',trim(name),&
        & 'Done smooth_aggregate '
-  if (allocated(l1rwsum)) deallocate(l1rwsum)
   call psb_erractionrestore(err_act)
   return
 

amgprec/impl/aggregator/clean.cpp

@@ -1,6 +1,6 @@
 #include "MatchBoxPC.h"
+
 // TODO comment
-#if !defined(SERIAL_MPI)
 
 void clean(MilanLongInt NLVer,
            MilanInt myRank,
@@ -89,4 +89,3 @@ void clean(MilanLongInt NLVer,
         }
     }
 }
-#endif

amgprec/impl/aggregator/computeCandidateMate.cpp

@@ -1,4 +1,5 @@
 #include "MatchBoxPC.h"
+
 /**
  * Execute the research fr the Candidate Mate without controlling if the vertices are already matched.
  * Returns the vertices with the highest weight
@@ -8,8 +9,7 @@
  * @param edgeLocWeight
  * @return
  */
-
-MilanLongInt firstComputeCandidateMateD(MilanLongInt adj1,
+MilanLongInt firstComputeCandidateMate(MilanLongInt adj1,
                                        MilanLongInt adj2,
                                        MilanLongInt *verLocInd,
                                        MilanReal *edgeLocWeight)
@@ -42,7 +42,7 @@ MilanLongInt firstComputeCandidateMateD(MilanLongInt adj1,
  * @param Ghost2LocalMap
  * @return
  */
-MilanLongInt computeCandidateMateD(MilanLongInt adj1,
+MilanLongInt computeCandidateMate(MilanLongInt adj1,
                                   MilanLongInt adj2,
                                   MilanReal *edgeLocWeight,
                                   MilanLongInt k,
@@ -60,7 +60,7 @@ MilanLongInt computeCandidateMateD(MilanLongInt adj1,
     for (k = adj1; k < adj2; k++)   {
       if (isAlreadyMatched(verLocInd[k], StartIndex, EndIndex, GMate, Mate, Ghost2LocalMap))
 	continue;
-
+      
       if ((edgeLocWeight[k] > heaviestEdgeWt) ||
 	  ((edgeLocWeight[k] == heaviestEdgeWt) && (w < verLocInd[k])))     {
 	heaviestEdgeWt = edgeLocWeight[k];
@@ -68,71 +68,6 @@ MilanLongInt computeCandidateMateD(MilanLongInt adj1,
       }
     } // End of for loop
       //  End: PARALLEL_COMPUTE_CANDIDATE_MATE_B(v)
-
+    
     return w;
 }
-
-
-MilanLongInt firstComputeCandidateMateS(MilanLongInt adj1,
-                                       MilanLongInt adj2,
-                                       MilanLongInt *verLocInd,
-                                       MilanFloat *edgeLocWeight)
-{
-    MilanInt w = -1;
-    MilanFloat heaviestEdgeWt = 0.0f; // Assign the smallest 
-    int finalK;
-    for (int k = adj1; k < adj2; k++) {
-      if ((edgeLocWeight[k] > heaviestEdgeWt) ||
-	  ((edgeLocWeight[k] == heaviestEdgeWt) && (w < verLocInd[k])))     {
-	heaviestEdgeWt = edgeLocWeight[k];
-	w = verLocInd[k];
-	finalK = k;
-      }
-    } // End of for loop
-    return finalK;
-}
-
-/**
- * //TODO documentation
- * @param adj1
- * @param adj2
- * @param edgeLocWeight
- * @param k
- * @param verLocInd
- * @param StartIndex
- * @param EndIndex
- * @param GMate
- * @param Mate
- * @param Ghost2LocalMap
- * @return
- */
-MilanLongInt computeCandidateMateS(MilanLongInt adj1,
-                                  MilanLongInt adj2,
-				  MilanFloat *edgeLocWeight,
-                                  MilanLongInt k,
-                                  MilanLongInt *verLocInd,
-                                  MilanLongInt StartIndex,
-                                  MilanLongInt EndIndex,
-                                  vector<MilanLongInt> &GMate,
-                                  MilanLongInt *Mate,
-                                  map<MilanLongInt, MilanLongInt> &Ghost2LocalMap)
-{
-    // Start: PARALLEL_COMPUTE_CANDIDATE_MATE_B(v)
-
-    MilanInt w = -1;
-    MilanFloat heaviestEdgeWt = 0.0f; // Assign the smallest Value
-    for (k = adj1; k < adj2; k++)   {
-      if (isAlreadyMatched(verLocInd[k], StartIndex, EndIndex, GMate, Mate, Ghost2LocalMap))
-	continue;
-
-      if ((edgeLocWeight[k] > heaviestEdgeWt) ||
-	  ((edgeLocWeight[k] == heaviestEdgeWt) && (w < verLocInd[k])))     {
-	heaviestEdgeWt = edgeLocWeight[k];
-	w = verLocInd[k];
-      }
-    } // End of for loop
-      //  End: PARALLEL_COMPUTE_CANDIDATE_MATE_B(v)
-
-    return w;
-}
-

amgprec/impl/aggregator/extractUChunk.cpp

@@ -1,4 +1,5 @@
 #include "MatchBoxPC.h"
+
 void extractUChunk(
     vector<MilanLongInt> &UChunkBeingProcessed,
     vector<MilanLongInt> &U,
@@ -27,4 +28,4 @@ void extractUChunk(
         }
 
     } // End of critical U // End of critical U
-}
+}

amgprec/impl/aggregator/findOwnerOfGhost.cpp

@@ -1,4 +1,5 @@
 #include "MatchBoxPC.h"
+
 /// Find the owner of a ghost node:
 MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
                           MilanInt myRank, MilanInt numProcs)

amgprec/impl/aggregator/initialize.cpp

@@ -1,4 +1,5 @@
 #include "MatchBoxPC.h"
+
 void initialize(MilanLongInt NLVer, MilanLongInt NLEdge,
                 MilanLongInt StartIndex, MilanLongInt EndIndex,
                 MilanLongInt *numGhostEdges,
@@ -290,7 +291,7 @@ void initialize(MilanLongInt NLVer, MilanLongInt NLEdge,
                 //new (&U) staticQueue(NLVer + (*numGhostVertices));
                 U.reserve(NLVer + (*numGhostVertices));
 
-                // Initialize the private vectors
+                // Initialize the private vectors                
                 privateQLocalVtx.reserve(*numGhostVertices);
                 privateQGhostVtx.reserve(*numGhostVertices);
                 privateQMsgType.reserve(*numGhostVertices);

amgprec/impl/aggregator/isAlreadyMatched.cpp

@@ -1,4 +1,5 @@
 #include "MatchBoxPC.h"
+
 /**
  * //TODO documentation
  * @param k
@@ -31,7 +32,7 @@ bool isAlreadyMatched(MilanLongInt node,
     */
     MilanLongInt val;
     if ((node < StartIndex) || (node > EndIndex)) // if ghost vertex
-    {
+    { 
 #pragma omp atomic read
         val = GMate[Ghost2LocalMap[node]];
         return val >= 0; // Already matched
@@ -42,4 +43,4 @@ bool isAlreadyMatched(MilanLongInt node,
     val = Mate[node - StartIndex];
 
     return val >= 0; // Already matched
-}
+}