Merge branch 'dev-openmp' into TestFerdous

TestFerdous
sfilippone 2 years ago
commit f523d0195f

@ -1,5 +1,6 @@
Changelog. A lot less detailed than usual, at least for past
history.
2022/05/20: Restart ChangeLog. Updated to new name AMG4PSBLAS, now using PSB3.8
2018/10/28: Fix interface to MUMPS and configry machinery. Require PSB 3.6.
2018/10/10: ICTXT argument in prec%init().
2018/07/30: Fixes for Intel compilers. BootCMatch interface in examples.

@ -1,10 +1,10 @@
AMG4PSBLAS version 1.0
AMG4PSBLAS version 1.1
Algebraic Multigrid Package
based on PSBLAS (Parallel Sparse BLAS version 3.7)
based on PSBLAS (Parallel Sparse BLAS version 3.8)
(C) Copyright 2021
(C) Copyright 2022
Salvatore Filippone
Pasqua D'Ambra

@ -1,10 +1,13 @@
include Make.inc
all: library
all: objs lib
library: libdir amgp cbnd
#cbnd
objs: amgp cbnd
lib: libdir objs
cd amgprec && $(MAKE) lib
cd cbind && $(MAKE) lib
libdir:
(if test ! -d lib ; then mkdir lib; fi)
@ -14,10 +17,11 @@ libdir:
amgp:
$(MAKE) -C amgprec all
cd amgprec && $(MAKE) objs
cbnd: amgp
$(MAKE) -C cbind all
install: all
cd cbind && $(MAKE) objs
install: lib
mkdir -p $(INSTALL_LIBDIR) &&\
$(INSTALL_DATA) lib/*.a $(INSTALL_LIBDIR)
mkdir -p $(INSTALL_INCLUDEDIR) &&\
@ -41,14 +45,14 @@ cleanlib:
(cd modules; /bin/rm -f *.a *$(.mod) *$(.fh))
veryclean: cleanlib
(cd amgprec; make veryclean)
(cd samples/simple/fileread; make clean)
(cd samples/simple/pdegen; make clean)
(cd samples/advanced/fileread; make clean)
(cd samples/advanced/pdegen; make clean)
(cd amgprec && $(MAKE) veryclean)
(cd samples/simple/fileread && $(MAKE) clean)
(cd samples/simple/pdegen && $(MAKE) clean)
(cd samples/advanced/fileread && $(MAKE) clean)
(cd samples/advanced/pdegen && $(MAKE) clean)
check: all
make check -C samples/advanced/pdegen
clean:
(cd amgprec; make clean)
(cd amgprec && $(MAKE) clean)

@ -1,6 +1,5 @@
AMG4PSBLAS
Algebraic Multigrid Package based on PSBLAS (Parallel Sparse BLAS version 3.7)
Algebraic Multigrid Package based on PSBLAS (Parallel Sparse BLAS version 3.8)
Salvatore Filippone (University of Rome Tor Vergata and IAC-CNR)
Pasqua D'Ambra (IAC-CNR, Naples, IT)

@ -63,17 +63,20 @@ OBJS=$(MODOBJS)
LOCAL_MODS=$(MODOBJS:.o=$(.mod))
LIBNAME=libamg_prec.a
all: lib impld
all: objs impld
impld: $(OBJS)
$(MAKE) -C impl
objs: $(OBJS)
/bin/cp -p amg_const.h $(INCDIR)
/bin/cp -p *$(.mod) $(MODDIR)
impld: objs
cd impl && $(MAKE)
lib: $(OBJS) impld
cd impl && $(MAKE) lib
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
$(RANLIB) $(HERE)/$(LIBNAME)
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
/bin/cp -p amg_const.h $(INCDIR)
/bin/cp -p *$(.mod) $(MODDIR)
$(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
@ -221,4 +224,4 @@ clean: implclean
/bin/rm -f $(OBJS) $(LOCAL_MODS) *$(.mod)
implclean:
$(MAKE) -C impl clean
cd impl && $(MAKE) clean

@ -64,7 +64,7 @@ module amg_base_prec_type
!
use psb_const_mod
use psb_base_mod, only :&
& psb_desc_type, psb_i_vect_type, psb_i_base_vect_type,&
& psb_desc_type, psb_ctxt_type,&
& psb_ipk_, psb_dpk_, psb_spk_, psb_epk_, &
& psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, &
& psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,&
@ -81,9 +81,9 @@ module amg_base_prec_type
!
! Version numbers
!
character(len=*), parameter :: amg_version_string_ = "1.0.0"
character(len=*), parameter :: amg_version_string_ = "1.1.0"
integer(psb_ipk_), parameter :: amg_version_major_ = 1
integer(psb_ipk_), parameter :: amg_version_minor_ = 0
integer(psb_ipk_), parameter :: amg_version_minor_ = 1
integer(psb_ipk_), parameter :: amg_patchlevel_ = 0
type amg_ml_parms
@ -656,43 +656,52 @@ contains
end if
end subroutine ml_parms_mlcycledsc
subroutine ml_parms_mldescr(pm,iout,info)
subroutine ml_parms_mldescr(pm,iout,info,prefix)
Implicit None
! Arguments
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
info = psb_success_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then
write(iout,*) ' Parallel aggregation algorithm: ',&
write(iout,*) trim(prefix),' Parallel aggregation algorithm: ',&
& par_aggr_alg_names(pm%par_aggr_alg)
if (pm%aggr_type>0) write(iout,*) ' Aggregation type: ',&
if (pm%aggr_type>0) write(iout,*) trim(prefix),' Aggregation type: ',&
& aggr_type_names(pm%aggr_type)
!if (pm%par_aggr_alg /= amg_ext_aggr_) then
if ( pm%aggr_ord /= amg_aggr_ord_nat_) &
& write(iout,*) ' with initial ordering: ',&
& write(iout,*) trim(prefix),' with initial ordering: ',&
& ord_names(pm%aggr_ord)
write(iout,*) ' Aggregation prolongator: ', &
write(iout,*) trim(prefix),' Aggregation prolongator: ', &
& aggr_prols(pm%aggr_prol)
if (pm%aggr_prol /= amg_no_smooth_) then
write(iout,*) ' with: ', aggr_filters(pm%aggr_filter)
write(iout,*) trim(prefix),' with: ', aggr_filters(pm%aggr_filter)
if (pm%aggr_omega_alg == amg_eig_est_) then
write(iout,*) ' Damping omega computation: spectral radius estimate'
write(iout,*) ' Spectral radius estimate: ', &
write(iout,*) trim(prefix),' Damping omega computation: spectral radius estimate'
write(iout,*) trim(prefix),' Spectral radius estimate: ', &
& eigen_estimates(pm%aggr_eig)
else if (pm%aggr_omega_alg == amg_user_choice_) then
write(iout,*) ' Damping omega computation: user defined value.'
write(iout,*) trim(prefix),' Damping omega computation: user defined value.'
else
write(iout,*) ' Damping omega computation: unknown value in iprcparm!!'
write(iout,*) trim(prefix),' Damping omega computation: unknown value in iprcparm!!'
end if
end if
!end if
else
write(iout,*) ' Multilevel type: Unkonwn value. Something is amiss....',&
write(iout,*) trim(prefix),' Multilevel type: Unkonwn value. Something is amiss....',&
& pm%ml_cycle
end if
@ -700,15 +709,16 @@ contains
end subroutine ml_parms_mldescr
subroutine ml_parms_descr(pm,iout,info,coarse)
subroutine ml_parms_descr(pm,iout,info,coarse,prefix)
Implicit None
! Arguments
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical :: coarse_
info = psb_success_
@ -719,7 +729,7 @@ contains
end if
if (coarse_) then
call pm%coarsedescr(iout,info)
call pm%coarsedescr(iout,info,prefix=prefix)
end if
return
@ -727,81 +737,126 @@ contains
end subroutine ml_parms_descr
subroutine ml_parms_coarsedescr(pm,iout,info)
subroutine ml_parms_coarsedescr(pm,iout,info,prefix)
Implicit None
! Arguments
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
info = psb_success_
write(iout,*) ' Coarse matrix: ',&
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix),' Coarse matrix: ',&
& matrix_names(pm%coarse_mat)
select case(pm%coarse_solve)
case (amg_bjac_,amg_as_)
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_pre
write(iout,*) ' Coarse solver: ',&
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'Block Jacobi'
case (amg_l1_bjac_)
write(iout,*) ' Number of sweeps : ',&
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
write(iout,*) ' Coarse solver: ',&
case (amg_l1_bjac_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'L1-Block Jacobi'
case (amg_jac_)
write(iout,*) ' Number of sweeps : ',&
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
write(iout,*) ' Coarse solver: ',&
case (amg_jac_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'Point Jacobi'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_l1_jac_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'L1-Jacobi'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_l1_fbgs_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'L1 Forward-Backward Gauss-Seidel (Hybrid)'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_l1_gs_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'L1 Gauss-Seidel (Hybrid)'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_fbgs_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'Forward-Backward Gauss-Seidel (Hybrid)'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case default
write(iout,*) ' Coarse solver: ',&
write(iout,*) trim(prefix),' Coarse solver: ',&
& amg_fact_names(pm%coarse_solve)
end select
end subroutine ml_parms_coarsedescr
subroutine s_ml_parms_descr(pm,iout,info,coarse)
subroutine s_ml_parms_descr(pm,iout,info,coarse,prefix)
Implicit None
! Arguments
class(amg_sml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
class(amg_sml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
info = psb_success_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
call pm%amg_ml_parms%descr(iout,info,coarse)
call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix)
if (pm%aggr_prol /= amg_no_smooth_) then
write(iout,*) ' Damping omega value :',pm%aggr_omega_val
write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val
end if
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh
write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh
return
end subroutine s_ml_parms_descr
subroutine d_ml_parms_descr(pm,iout,info,coarse)
subroutine d_ml_parms_descr(pm,iout,info,coarse,prefix)
Implicit None
! Arguments
class(amg_dml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
class(amg_dml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
info = psb_success_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
call pm%amg_ml_parms%descr(iout,info,coarse)
call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix)
if (pm%aggr_prol /= amg_no_smooth_) then
write(iout,*) ' Damping omega value :',pm%aggr_omega_val
write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val
end if
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh
write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh
return

@ -198,7 +198,7 @@ module amg_c_ainv_solver
!!$ end interface
interface
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse)
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
Implicit None
@ -208,7 +208,7 @@ module amg_c_ainv_solver
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_c_ainv_solver_descr
end interface

@ -396,21 +396,23 @@ contains
end subroutine c_as_smoother_default
subroutine c_as_smoother_descr(sm,info,iout,coarse)
subroutine c_as_smoother_descr(sm,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_c_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_as_smoother_descr'
integer(psb_ipk_) :: iout_
logical :: coarse_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -424,16 +426,21 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (.not.coarse_) then
write(iout_,*) ' Additive Schwarz with ',&
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
& sm%novr, ' overlap layers.'
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) ' Local solver:'
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) trim(prefix_), ' Local solver:'
endif
if (allocated(sm%sv)) then
call sm%sv%descr(info,iout_,coarse=coarse)
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
end if
call psb_erractionrestore(err_act)

@ -275,15 +275,22 @@ contains
val = .false.
end function amg_c_base_aggregator_xt_desc
subroutine amg_c_base_aggregator_descr(ag,parms,iout,info)
subroutine amg_c_base_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_c_base_aggregator_type), intent(in) :: ag
type(amg_sml_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,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_c_base_aggregator_descr

@ -272,7 +272,7 @@ module amg_c_base_smoother_mod
end interface
interface
subroutine amg_c_base_smoother_descr(sm,info,iout,coarse)
subroutine amg_c_base_smoother_descr(sm,info,iout,coarse,prefix)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_smoother_type, psb_ipk_
@ -281,6 +281,7 @@ module amg_c_base_smoother_mod
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_c_base_smoother_descr
end interface

@ -270,7 +270,7 @@ module amg_c_base_solver_mod
end interface
interface
subroutine amg_c_base_solver_descr(sv,info,iout,coarse)
subroutine amg_c_base_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_solver_type, psb_ipk_
@ -281,7 +281,7 @@ module amg_c_base_solver_mod
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_c_base_solver_descr
end interface

@ -184,16 +184,23 @@ contains
val = "Decoupled aggregation"
end function amg_c_dec_aggregator_fmt
subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info)
subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_c_dec_aggregator_type), intent(in) :: ag
type(amg_sml_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,*) 'Decoupled Aggregator'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_c_dec_aggregator_descr

@ -219,7 +219,7 @@ contains
end subroutine c_diag_solver_free
subroutine c_diag_solver_descr(sv,info,iout,coarse)
subroutine c_diag_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -228,11 +228,13 @@ contains
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_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@ -240,8 +242,13 @@ contains
else
iout_ = psb_out_unit
endif
write(iout_,*) ' Diagonal local solver '
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Diagonal local solver '
return
@ -352,7 +359,7 @@ module amg_c_l1_diag_solver
contains
subroutine c_l1_diag_solver_descr(sv,info,iout,coarse)
subroutine c_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -361,11 +368,13 @@ contains
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_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@ -373,8 +382,13 @@ contains
else
iout_ = psb_out_unit
endif
write(iout_,*) ' L1 Diagonal solver '
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
return

@ -433,20 +433,22 @@ contains
return
end subroutine c_gs_solver_free
subroutine c_gs_solver_descr(sv,info,iout,coarse)
subroutine c_gs_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_c_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_gs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -455,12 +457,17 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
@ -526,20 +533,22 @@ contains
val = .true.
end function c_gs_solver_is_iterative
subroutine c_bwgs_solver_descr(sv,info,iout,coarse)
subroutine c_bwgs_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_c_bwgs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_bwgs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -548,12 +557,17 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if

@ -157,7 +157,7 @@ contains
return
end subroutine c_id_solver_free
subroutine c_id_solver_descr(sv,info,iout,coarse)
subroutine c_id_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -165,12 +165,14 @@ contains
class(amg_c_id_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_id_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@ -178,8 +180,13 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' Identity local solver '
write(iout_,*) trim(prefix_), ' Identity local solver '
return

@ -406,7 +406,7 @@ contains
return
end subroutine c_ilu_solver_free
subroutine c_ilu_solver_descr(sv,info,iout,coarse)
subroutine c_ilu_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -414,12 +414,14 @@ contains
class(amg_c_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_ilu_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -428,15 +430,20 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' Incomplete factorization solver: ',&
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
& amg_fact_names(sv%fact_type)
select case(sv%fact_type)
case(psb_ilu_n_,psb_milu_n_)
write(iout_,*) ' Fill level:',sv%fill_in
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
case(psb_ilu_t_)
write(iout_,*) ' Fill level:',sv%fill_in
write(iout_,*) ' Fill threshold :',sv%thresh
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
end select
call psb_erractionrestore(err_act)

@ -123,7 +123,7 @@ module amg_c_invk_solver
end interface
interface
subroutine amg_c_invk_solver_descr(sv,info,iout,coarse)
subroutine amg_c_invk_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_spk_, amg_c_invk_solver_type, psb_ipk_
Implicit None
@ -133,7 +133,7 @@ module amg_c_invk_solver
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_c_invk_solver_descr
end interface

@ -134,16 +134,17 @@ module amg_c_invt_solver
end interface
interface
subroutine amg_c_invt_solver_descr(sv,info,iout,coarse)
subroutine amg_c_invt_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_spk_, amg_c_invt_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_c_invt_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_c_invt_solver_descr
end interface

@ -219,12 +219,13 @@ module amg_c_jac_smoother
end interface
interface
subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse)
subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse,prefix)
import :: amg_c_jac_smoother_type, psb_ipk_
class(amg_c_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_c_jac_smoother_descr
end interface
@ -313,12 +314,13 @@ module amg_c_jac_smoother
end interface
interface
subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse)
subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
import :: amg_c_l1_jac_smoother_type, psb_ipk_
class(amg_c_l1_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_c_l1_jac_smoother_descr
end interface

@ -436,7 +436,7 @@ contains
val = "KRM solver"
end function c_krm_solver_get_fmt
subroutine c_krm_solver_descr(sv,info,iout,coarse)
subroutine c_krm_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -444,12 +444,14 @@ contains
class(amg_c_krm_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_krm_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -458,23 +460,22 @@ contains
else
iout_ = psb_out_unit
endif
if (sv%global) then
write(iout_,*) ' Krylov solver (global)'
if (present(prefix)) then
prefix_ = prefix
else
write(iout_,*) ' Krylov solver (local) '
prefix_ = ""
end if
write(iout_,*) ' method: ',sv%method
write(iout_,*) ' kprec: ',sv%kprec
if (sv%i_sub_solve > 0) then
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
if (sv%global) then
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
else
write(iout_,*) ' sub_solve: ',sv%sub_solve
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
end if
write(iout_,*) ' itmax: ',sv%itmax
write(iout_,*) ' eps: ',sv%eps
write(iout_,*) ' fillin: ',sv%fillin
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
call psb_erractionrestore(err_act)
return

@ -313,22 +313,24 @@ subroutine c_mumps_solver_finalize(sv)
end subroutine c_mumps_solver_finalize
subroutine c_mumps_solver_descr(sv,info,iout,coarse)
subroutine c_mumps_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_c_mumps_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -337,8 +339,13 @@ subroutine c_mumps_solver_descr(sv,info,iout,coarse)
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' MUMPS Solver. '
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
call psb_erractionrestore(err_act)
return

@ -257,7 +257,7 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@ -268,6 +268,7 @@ module amg_c_onelev_mod
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
end subroutine amg_c_base_onelev_descr
end interface

@ -155,15 +155,16 @@ module amg_c_prec_type
interface amg_precdescr
subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity)
subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity,prefix)
import :: amg_cprec_type, psb_ipk_
implicit none
! Arguments
class(amg_cprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
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
end subroutine amg_cfile_prec_descr
end interface

@ -385,20 +385,22 @@ contains
end subroutine c_slu_solver_finalize
subroutine c_slu_solver_descr(sv,info,iout,coarse)
subroutine c_slu_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_c_slu_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer :: err_act
character(len=20), parameter :: name='amg_c_slu_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -407,8 +409,13 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return

@ -88,16 +88,25 @@ contains
val = "Symmetric Decoupled aggregation"
end function amg_c_symdec_aggregator_fmt
subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info)
subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_c_symdec_aggregator_type), intent(in) :: ag
type(amg_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_c_symdec_aggregator_descr

@ -198,7 +198,7 @@ module amg_d_ainv_solver
!!$ end interface
interface
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse)
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
Implicit None
@ -208,7 +208,7 @@ module amg_d_ainv_solver
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_ainv_solver_descr
end interface

@ -396,21 +396,23 @@ contains
end subroutine d_as_smoother_default
subroutine d_as_smoother_descr(sm,info,iout,coarse)
subroutine d_as_smoother_descr(sm,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_d_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_as_smoother_descr'
integer(psb_ipk_) :: iout_
logical :: coarse_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -424,16 +426,21 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (.not.coarse_) then
write(iout_,*) ' Additive Schwarz with ',&
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
& sm%novr, ' overlap layers.'
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) ' Local solver:'
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) trim(prefix_), ' Local solver:'
endif
if (allocated(sm%sv)) then
call sm%sv%descr(info,iout_,coarse=coarse)
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
end if
call psb_erractionrestore(err_act)

@ -275,15 +275,22 @@ contains
val = .false.
end function amg_d_base_aggregator_xt_desc
subroutine amg_d_base_aggregator_descr(ag,parms,iout,info)
subroutine amg_d_base_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_d_base_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,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_d_base_aggregator_descr

@ -272,7 +272,7 @@ module amg_d_base_smoother_mod
end interface
interface
subroutine amg_d_base_smoother_descr(sm,info,iout,coarse)
subroutine amg_d_base_smoother_descr(sm,info,iout,coarse,prefix)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_smoother_type, psb_ipk_
@ -281,6 +281,7 @@ module amg_d_base_smoother_mod
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_base_smoother_descr
end interface

@ -270,7 +270,7 @@ module amg_d_base_solver_mod
end interface
interface
subroutine amg_d_base_solver_descr(sv,info,iout,coarse)
subroutine amg_d_base_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_solver_type, psb_ipk_
@ -281,7 +281,7 @@ module amg_d_base_solver_mod
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_base_solver_descr
end interface

@ -184,16 +184,23 @@ contains
val = "Decoupled aggregation"
end function amg_d_dec_aggregator_fmt
subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info)
subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_d_dec_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,*) 'Decoupled Aggregator'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_d_dec_aggregator_descr

@ -496,23 +496,23 @@ contains
!
! Now call matching!
!
if (debug) write(0,*) iam,' buildmatching into PMatchBox:'
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 PMatchBox:', info
if (debug) write(0,*) iam,' buildmatching from NewMatch:', info
if (debug_sync) then
call psb_max(ictxt,info)
if (iam == 0) write(0,*)' done PMatchBox', 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 (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 '

@ -219,7 +219,7 @@ contains
end subroutine d_diag_solver_free
subroutine d_diag_solver_descr(sv,info,iout,coarse)
subroutine d_diag_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -228,11 +228,13 @@ contains
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_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@ -240,8 +242,13 @@ contains
else
iout_ = psb_out_unit
endif
write(iout_,*) ' Diagonal local solver '
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Diagonal local solver '
return
@ -352,7 +359,7 @@ module amg_d_l1_diag_solver
contains
subroutine d_l1_diag_solver_descr(sv,info,iout,coarse)
subroutine d_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -361,11 +368,13 @@ contains
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_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@ -373,8 +382,13 @@ contains
else
iout_ = psb_out_unit
endif
write(iout_,*) ' L1 Diagonal solver '
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
return

@ -433,20 +433,22 @@ contains
return
end subroutine d_gs_solver_free
subroutine d_gs_solver_descr(sv,info,iout,coarse)
subroutine d_gs_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_d_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_gs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -455,12 +457,17 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
@ -526,20 +533,22 @@ contains
val = .true.
end function d_gs_solver_is_iterative
subroutine d_bwgs_solver_descr(sv,info,iout,coarse)
subroutine d_bwgs_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_d_bwgs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_bwgs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -548,12 +557,17 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if

@ -157,7 +157,7 @@ contains
return
end subroutine d_id_solver_free
subroutine d_id_solver_descr(sv,info,iout,coarse)
subroutine d_id_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -165,12 +165,14 @@ contains
class(amg_d_id_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_id_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@ -178,8 +180,13 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' Identity local solver '
write(iout_,*) trim(prefix_), ' Identity local solver '
return

@ -406,7 +406,7 @@ contains
return
end subroutine d_ilu_solver_free
subroutine d_ilu_solver_descr(sv,info,iout,coarse)
subroutine d_ilu_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -414,12 +414,14 @@ contains
class(amg_d_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_ilu_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -428,15 +430,20 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' Incomplete factorization solver: ',&
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
& amg_fact_names(sv%fact_type)
select case(sv%fact_type)
case(psb_ilu_n_,psb_milu_n_)
write(iout_,*) ' Fill level:',sv%fill_in
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
case(psb_ilu_t_)
write(iout_,*) ' Fill level:',sv%fill_in
write(iout_,*) ' Fill threshold :',sv%thresh
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
end select
call psb_erractionrestore(err_act)

@ -123,7 +123,7 @@ module amg_d_invk_solver
end interface
interface
subroutine amg_d_invk_solver_descr(sv,info,iout,coarse)
subroutine amg_d_invk_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_dpk_, amg_d_invk_solver_type, psb_ipk_
Implicit None
@ -133,7 +133,7 @@ module amg_d_invk_solver
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_invk_solver_descr
end interface

@ -134,16 +134,17 @@ module amg_d_invt_solver
end interface
interface
subroutine amg_d_invt_solver_descr(sv,info,iout,coarse)
subroutine amg_d_invt_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_dpk_, amg_d_invt_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_d_invt_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_invt_solver_descr
end interface

@ -219,12 +219,13 @@ module amg_d_jac_smoother
end interface
interface
subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse)
subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse,prefix)
import :: amg_d_jac_smoother_type, psb_ipk_
class(amg_d_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_d_jac_smoother_descr
end interface
@ -313,12 +314,13 @@ module amg_d_jac_smoother
end interface
interface
subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse)
subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
import :: amg_d_l1_jac_smoother_type, psb_ipk_
class(amg_d_l1_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_l1_jac_smoother_descr
end interface

@ -436,7 +436,7 @@ contains
val = "KRM solver"
end function d_krm_solver_get_fmt
subroutine d_krm_solver_descr(sv,info,iout,coarse)
subroutine d_krm_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -444,12 +444,14 @@ contains
class(amg_d_krm_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_krm_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -458,23 +460,22 @@ contains
else
iout_ = psb_out_unit
endif
if (sv%global) then
write(iout_,*) ' Krylov solver (global)'
if (present(prefix)) then
prefix_ = prefix
else
write(iout_,*) ' Krylov solver (local) '
prefix_ = ""
end if
write(iout_,*) ' method: ',sv%method
write(iout_,*) ' kprec: ',sv%kprec
if (sv%i_sub_solve > 0) then
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
if (sv%global) then
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
else
write(iout_,*) ' sub_solve: ',sv%sub_solve
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
end if
write(iout_,*) ' itmax: ',sv%itmax
write(iout_,*) ' eps: ',sv%eps
write(iout_,*) ' fillin: ',sv%fillin
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
call psb_erractionrestore(err_act)
return

@ -143,9 +143,10 @@ contains
type(psb_ld_coo_sparse_mat) :: tmpcoo
logical :: display_out_, print_out_, reproducible_
logical, parameter :: dump=.false., debug=.false., dump_mate=.false., &
& debug_ilaggr=.false., debug_sync=.false.
& debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
logical, parameter :: do_timings=.true.
integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
ictxt = desc_a%get_ctxt()
call psb_info(ictxt,iam,np)
@ -187,7 +188,7 @@ contains
call desc_a%l2gip(ilv,info,owned=.false.)
call psb_geall(ilaggr,desc_a,info)
ilaggr = -1
ilaggr = ilaggr_neginit
call psb_geasb(ilaggr,desc_a,info)
nr = a%get_nrows()
nc = a%get_ncols()
@ -213,7 +214,20 @@ contains
call psb_barrier(ictxt)
if (iam == 0) write(0,*)' out from buildmatching:', info
end if
if (debug_mate) then
block
integer(psb_lpk_), allocatable :: ckmate(:)
allocate(ckmate(nr))
ckmate(1:nr) = mate(1:nr)
call psb_msort(ckmate(1:nr))
do i=1,nr-1
if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
write(0,*) iam,' Duplicate mate entry at',i,' :',ckmate(i)
end if
end do
end block
end if
if (info == 0) then
if (do_timings) call psb_tic(idx_phase2)
if (debug_sync) then
@ -259,7 +273,7 @@ contains
cycle
else
if (ilaggr(k) == -1) then
if (ilaggr(k) == ilaggr_neginit) then
wk = w(k)
widx = w(idx)
@ -267,7 +281,7 @@ contains
nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
if (nrmagg > epsilon(nrmagg)) then
if (idx <= nr) then
if (ilaggr(idx) == -1) then
if (ilaggr(idx) == ilaggr_neginit) then
! Now, if both vertices are local, the aggregate is local
! (kinda obvious).
nlaggr(iam) = nlaggr(iam) + 1
@ -275,6 +289,9 @@ contains
ilaggr(idx) = nlaggr(iam)
wtemp(k) = w(k)/nrmagg
wtemp(idx) = w(idx)/nrmagg
else
write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
&mate(idx),ilaggr(idx)
end if
nlpairs = nlpairs+1
else if (idx <= nc) then
@ -294,7 +311,7 @@ contains
ilaggr(k) = nlaggr(iam)
nlpairs = nlpairs+1
else
ilaggr(k) = -2
ilaggr(k) = ilaggr_nonlocal
end if
else
! Use a statistically unbiased tie-breaking rule,
@ -309,7 +326,7 @@ contains
ilaggr(k) = nlaggr(iam)
nlpairs = nlpairs+1
else
ilaggr(k) = -2
ilaggr(k) = ilaggr_nonlocal
end if
end if
end if
@ -325,6 +342,12 @@ contains
nlsingl = nlsingl + 1
end if
end if
if (ilaggr(k) == ilaggr_neginit) then
write(0,*) iam,' Error: no update to ',k,mate(k),&
& abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
end if
else
if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
end if
end if
end do
@ -332,7 +355,7 @@ contains
if (do_timings) call psb_tic(idx_phase3)
! Ok, now compute offsets, gather halo and fix non-local
! aggregates (those where ilaggr == -2)
! aggregates (those where ilaggr == ilaggr_nonlocal)
call psb_sum(ictxt,nlaggr)
ntaggr = sum(nlaggr(0:np-1))
naggrm1 = sum(nlaggr(0:iam-1))
@ -347,7 +370,7 @@ contains
call psb_halo(wtemp,desc_a,info)
! Cleanup as yet unmarked entries
do k=1,nr
if (ilaggr(k) == -2) then
if (ilaggr(k) == ilaggr_nonlocal) then
idx = mate(k)
if (idx > nr) then
i = ilaggr(idx)
@ -359,9 +382,14 @@ contains
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,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
else if (ilaggr(k) <0) then
write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
write(0,*) iam,' : : ',nr,nc,mate(k)
if (mate(k) <= nr) then
write(0,*) iam,' : : ',ilaggr(mate(k)),mate(mate(k)),&
& ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
end if
flush(0)
end if
end do
if (debug_sync) then
@ -414,7 +442,7 @@ contains
end block
if (iam == 0) then
write(0,*) 'Matching statistics: Unmatched nodes ',&
write(0,*) iam,'Matching statistics: Unmatched nodes ',&
& nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
end if

@ -313,22 +313,24 @@ subroutine d_mumps_solver_finalize(sv)
end subroutine d_mumps_solver_finalize
subroutine d_mumps_solver_descr(sv,info,iout,coarse)
subroutine d_mumps_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_d_mumps_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -337,8 +339,13 @@ subroutine d_mumps_solver_descr(sv,info,iout,coarse)
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' MUMPS Solver. '
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
call psb_erractionrestore(err_act)
return

@ -329,17 +329,24 @@ contains
val = "new matching aggregation"
end function d_newmatch_aggregator_fmt
subroutine d_newmatch_aggregator_descr(ag,parms,iout,info)
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,*) 'NewMatch Aggregator'
write(iout,*) ' Number of Matching sweeps: ',ag%n_sweeps
write(iout,*) ' Matching algorithm : ',ag%matching_alg
write(iout,*) 'Aggregator object type: ',ag%fmt()
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

@ -259,7 +259,7 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@ -270,6 +270,7 @@ module amg_d_onelev_mod
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
end subroutine amg_d_base_onelev_descr
end interface

@ -132,8 +132,6 @@ module amg_d_parmatch_aggregator_mod
type(psb_dspmat_type), allocatable :: prol, restr
type(psb_dspmat_type), allocatable :: ac, base_a, rwa
type(psb_desc_type), allocatable :: desc_ac, desc_ax, base_desc, rwdesc
integer(psb_ipk_) :: max_csize
integer(psb_ipk_) :: max_nlevels
logical :: reproducible_matching = .false.
logical :: need_symmetrize = .false.
logical :: unsmoothed_hierarchy = .true.
@ -392,18 +390,25 @@ contains
end function amg_d_parmatch_aggregator_sizeof
subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info)
subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_d_parmatch_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,*) 'Parallel Matching Aggregator'
write(iout,*) ' Number of matching sweeps: ',ag%n_sweeps
write(iout,*) ' Matching algorithm : MatchBoxP (PREIS)'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps
write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_d_parmatch_aggregator_descr
@ -452,10 +457,10 @@ contains
& agnext%matching_alg = ag%matching_alg
if (.not.is_legal_nsweeps(agnext%n_sweeps))&
& agnext%n_sweeps = ag%n_sweeps
if (.not.is_legal_csize(agnext%max_csize))&
& agnext%max_csize = ag%max_csize
if (.not.is_legal_nlevels(agnext%max_nlevels))&
& agnext%max_nlevels = ag%max_nlevels
!!$ if (.not.is_legal_csize(agnext%max_csize))&
!!$ & agnext%max_csize = ag%max_csize
!!$ if (.not.is_legal_nlevels(agnext%max_nlevels))&
!!$ & agnext%max_nlevels = ag%max_nlevels
! Is this going to generate shallow copies/memory leaks/double frees?
! To be investigated further.
call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
@ -540,10 +545,6 @@ contains
case('AGGR_SIZE')
ag%orig_aggr_size = val
ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
case('PRMC_MAX_CSIZE')
ag%max_csize=val
case('PRMC_MAX_NLEVELS')
ag%max_nlevels=val
case('PRMC_W_SIZE')
call ag%bld_default_w(val)
case('PRMC_REPRODUCIBLE_MATCHING')
@ -569,8 +570,8 @@ contains
ag%matching_alg = 0
ag%n_sweeps = 1
ag%jacobi_sweeps = 0
ag%max_nlevels = 36
ag%max_csize = -1
!!$ ag%max_nlevels = 36
!!$ ag%max_csize = -1
!
! Apparently BootCMatch works better
! by keeping all entries

@ -155,15 +155,16 @@ module amg_d_prec_type
interface amg_precdescr
subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity)
subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity,prefix)
import :: amg_dprec_type, psb_ipk_
implicit none
! Arguments
class(amg_dprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
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
end subroutine amg_dfile_prec_descr
end interface

@ -385,20 +385,22 @@ contains
end subroutine d_slu_solver_finalize
subroutine d_slu_solver_descr(sv,info,iout,coarse)
subroutine d_slu_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_d_slu_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer :: err_act
character(len=20), parameter :: name='amg_d_slu_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -407,8 +409,13 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return

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

@ -88,16 +88,25 @@ contains
val = "Symmetric Decoupled aggregation"
end function amg_d_symdec_aggregator_fmt
subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info)
subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_d_symdec_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
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_d_symdec_aggregator_descr

@ -390,20 +390,22 @@ contains
end subroutine d_umf_solver_finalize
subroutine d_umf_solver_descr(sv,info,iout,coarse)
subroutine d_umf_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_d_umf_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer :: err_act
character(len=20), parameter :: name='amg_d_umf_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -412,8 +414,13 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' UMFPACK Sparse Factorization Solver. '
write(iout_,*) trim(prefix_), ' UMFPACK Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return

@ -198,7 +198,7 @@ module amg_s_ainv_solver
!!$ end interface
interface
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse)
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
Implicit None
@ -208,7 +208,7 @@ module amg_s_ainv_solver
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_ainv_solver_descr
end interface

@ -396,21 +396,23 @@ contains
end subroutine s_as_smoother_default
subroutine s_as_smoother_descr(sm,info,iout,coarse)
subroutine s_as_smoother_descr(sm,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_s_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_as_smoother_descr'
integer(psb_ipk_) :: iout_
logical :: coarse_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -424,16 +426,21 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (.not.coarse_) then
write(iout_,*) ' Additive Schwarz with ',&
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
& sm%novr, ' overlap layers.'
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) ' Local solver:'
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) trim(prefix_), ' Local solver:'
endif
if (allocated(sm%sv)) then
call sm%sv%descr(info,iout_,coarse=coarse)
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
end if
call psb_erractionrestore(err_act)

@ -275,15 +275,22 @@ contains
val = .false.
end function amg_s_base_aggregator_xt_desc
subroutine amg_s_base_aggregator_descr(ag,parms,iout,info)
subroutine amg_s_base_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_s_base_aggregator_type), intent(in) :: ag
type(amg_sml_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,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_s_base_aggregator_descr

@ -272,7 +272,7 @@ module amg_s_base_smoother_mod
end interface
interface
subroutine amg_s_base_smoother_descr(sm,info,iout,coarse)
subroutine amg_s_base_smoother_descr(sm,info,iout,coarse,prefix)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_smoother_type, psb_ipk_
@ -281,6 +281,7 @@ module amg_s_base_smoother_mod
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_base_smoother_descr
end interface

@ -270,7 +270,7 @@ module amg_s_base_solver_mod
end interface
interface
subroutine amg_s_base_solver_descr(sv,info,iout,coarse)
subroutine amg_s_base_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_solver_type, psb_ipk_
@ -281,7 +281,7 @@ module amg_s_base_solver_mod
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_base_solver_descr
end interface

@ -184,16 +184,23 @@ contains
val = "Decoupled aggregation"
end function amg_s_dec_aggregator_fmt
subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info)
subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_s_dec_aggregator_type), intent(in) :: ag
type(amg_sml_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,*) 'Decoupled Aggregator'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_s_dec_aggregator_descr

@ -219,7 +219,7 @@ contains
end subroutine s_diag_solver_free
subroutine s_diag_solver_descr(sv,info,iout,coarse)
subroutine s_diag_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -228,11 +228,13 @@ contains
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_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@ -240,8 +242,13 @@ contains
else
iout_ = psb_out_unit
endif
write(iout_,*) ' Diagonal local solver '
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Diagonal local solver '
return
@ -352,7 +359,7 @@ module amg_s_l1_diag_solver
contains
subroutine s_l1_diag_solver_descr(sv,info,iout,coarse)
subroutine s_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -361,11 +368,13 @@ contains
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_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@ -373,8 +382,13 @@ contains
else
iout_ = psb_out_unit
endif
write(iout_,*) ' L1 Diagonal solver '
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
return

@ -433,20 +433,22 @@ contains
return
end subroutine s_gs_solver_free
subroutine s_gs_solver_descr(sv,info,iout,coarse)
subroutine s_gs_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_s_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_gs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -455,12 +457,17 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
@ -526,20 +533,22 @@ contains
val = .true.
end function s_gs_solver_is_iterative
subroutine s_bwgs_solver_descr(sv,info,iout,coarse)
subroutine s_bwgs_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_s_bwgs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_bwgs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -548,12 +557,17 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if

@ -157,7 +157,7 @@ contains
return
end subroutine s_id_solver_free
subroutine s_id_solver_descr(sv,info,iout,coarse)
subroutine s_id_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -165,12 +165,14 @@ contains
class(amg_s_id_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_id_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@ -178,8 +180,13 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' Identity local solver '
write(iout_,*) trim(prefix_), ' Identity local solver '
return

@ -406,7 +406,7 @@ contains
return
end subroutine s_ilu_solver_free
subroutine s_ilu_solver_descr(sv,info,iout,coarse)
subroutine s_ilu_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -414,12 +414,14 @@ contains
class(amg_s_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_ilu_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -428,15 +430,20 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' Incomplete factorization solver: ',&
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
& amg_fact_names(sv%fact_type)
select case(sv%fact_type)
case(psb_ilu_n_,psb_milu_n_)
write(iout_,*) ' Fill level:',sv%fill_in
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
case(psb_ilu_t_)
write(iout_,*) ' Fill level:',sv%fill_in
write(iout_,*) ' Fill threshold :',sv%thresh
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
end select
call psb_erractionrestore(err_act)

@ -123,7 +123,7 @@ module amg_s_invk_solver
end interface
interface
subroutine amg_s_invk_solver_descr(sv,info,iout,coarse)
subroutine amg_s_invk_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_spk_, amg_s_invk_solver_type, psb_ipk_
Implicit None
@ -133,7 +133,7 @@ module amg_s_invk_solver
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_invk_solver_descr
end interface

@ -134,16 +134,17 @@ module amg_s_invt_solver
end interface
interface
subroutine amg_s_invt_solver_descr(sv,info,iout,coarse)
subroutine amg_s_invt_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_spk_, amg_s_invt_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_s_invt_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_invt_solver_descr
end interface

@ -219,12 +219,13 @@ module amg_s_jac_smoother
end interface
interface
subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse)
subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse,prefix)
import :: amg_s_jac_smoother_type, psb_ipk_
class(amg_s_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_s_jac_smoother_descr
end interface
@ -313,12 +314,13 @@ module amg_s_jac_smoother
end interface
interface
subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse)
subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
import :: amg_s_l1_jac_smoother_type, psb_ipk_
class(amg_s_l1_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_l1_jac_smoother_descr
end interface

@ -436,7 +436,7 @@ contains
val = "KRM solver"
end function s_krm_solver_get_fmt
subroutine s_krm_solver_descr(sv,info,iout,coarse)
subroutine s_krm_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -444,12 +444,14 @@ contains
class(amg_s_krm_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_krm_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -458,23 +460,22 @@ contains
else
iout_ = psb_out_unit
endif
if (sv%global) then
write(iout_,*) ' Krylov solver (global)'
if (present(prefix)) then
prefix_ = prefix
else
write(iout_,*) ' Krylov solver (local) '
prefix_ = ""
end if
write(iout_,*) ' method: ',sv%method
write(iout_,*) ' kprec: ',sv%kprec
if (sv%i_sub_solve > 0) then
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
if (sv%global) then
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
else
write(iout_,*) ' sub_solve: ',sv%sub_solve
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
end if
write(iout_,*) ' itmax: ',sv%itmax
write(iout_,*) ' eps: ',sv%eps
write(iout_,*) ' fillin: ',sv%fillin
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
call psb_erractionrestore(err_act)
return

@ -143,9 +143,10 @@ contains
type(psb_ls_coo_sparse_mat) :: tmpcoo
logical :: display_out_, print_out_, reproducible_
logical, parameter :: dump=.false., debug=.false., dump_mate=.false., &
& debug_ilaggr=.false., debug_sync=.false.
& debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
logical, parameter :: do_timings=.true.
integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
ictxt = desc_a%get_ctxt()
call psb_info(ictxt,iam,np)
@ -187,7 +188,7 @@ contains
call desc_a%l2gip(ilv,info,owned=.false.)
call psb_geall(ilaggr,desc_a,info)
ilaggr = -1
ilaggr = ilaggr_neginit
call psb_geasb(ilaggr,desc_a,info)
nr = a%get_nrows()
nc = a%get_ncols()
@ -213,7 +214,20 @@ contains
call psb_barrier(ictxt)
if (iam == 0) write(0,*)' out from buildmatching:', info
end if
if (debug_mate) then
block
integer(psb_lpk_), allocatable :: ckmate(:)
allocate(ckmate(nr))
ckmate(1:nr) = mate(1:nr)
call psb_msort(ckmate(1:nr))
do i=1,nr-1
if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
write(0,*) iam,' Duplicate mate entry at',i,' :',ckmate(i)
end if
end do
end block
end if
if (info == 0) then
if (do_timings) call psb_tic(idx_phase2)
if (debug_sync) then
@ -259,7 +273,7 @@ contains
cycle
else
if (ilaggr(k) == -1) then
if (ilaggr(k) == ilaggr_neginit) then
wk = w(k)
widx = w(idx)
@ -267,7 +281,7 @@ contains
nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
if (nrmagg > epsilon(nrmagg)) then
if (idx <= nr) then
if (ilaggr(idx) == -1) then
if (ilaggr(idx) == ilaggr_neginit) then
! Now, if both vertices are local, the aggregate is local
! (kinda obvious).
nlaggr(iam) = nlaggr(iam) + 1
@ -275,6 +289,9 @@ contains
ilaggr(idx) = nlaggr(iam)
wtemp(k) = w(k)/nrmagg
wtemp(idx) = w(idx)/nrmagg
else
write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
&mate(idx),ilaggr(idx)
end if
nlpairs = nlpairs+1
else if (idx <= nc) then
@ -294,7 +311,7 @@ contains
ilaggr(k) = nlaggr(iam)
nlpairs = nlpairs+1
else
ilaggr(k) = -2
ilaggr(k) = ilaggr_nonlocal
end if
else
! Use a statistically unbiased tie-breaking rule,
@ -309,7 +326,7 @@ contains
ilaggr(k) = nlaggr(iam)
nlpairs = nlpairs+1
else
ilaggr(k) = -2
ilaggr(k) = ilaggr_nonlocal
end if
end if
end if
@ -325,6 +342,12 @@ contains
nlsingl = nlsingl + 1
end if
end if
if (ilaggr(k) == ilaggr_neginit) then
write(0,*) iam,' Error: no update to ',k,mate(k),&
& abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
end if
else
if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
end if
end if
end do
@ -332,7 +355,7 @@ contains
if (do_timings) call psb_tic(idx_phase3)
! Ok, now compute offsets, gather halo and fix non-local
! aggregates (those where ilaggr == -2)
! aggregates (those where ilaggr == ilaggr_nonlocal)
call psb_sum(ictxt,nlaggr)
ntaggr = sum(nlaggr(0:np-1))
naggrm1 = sum(nlaggr(0:iam-1))
@ -347,7 +370,7 @@ contains
call psb_halo(wtemp,desc_a,info)
! Cleanup as yet unmarked entries
do k=1,nr
if (ilaggr(k) == -2) then
if (ilaggr(k) == ilaggr_nonlocal) then
idx = mate(k)
if (idx > nr) then
i = ilaggr(idx)
@ -359,9 +382,14 @@ contains
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,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
else if (ilaggr(k) <0) then
write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
write(0,*) iam,' : : ',nr,nc,mate(k)
if (mate(k) <= nr) then
write(0,*) iam,' : : ',ilaggr(mate(k)),mate(mate(k)),&
& ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
end if
flush(0)
end if
end do
if (debug_sync) then
@ -414,7 +442,7 @@ contains
end block
if (iam == 0) then
write(0,*) 'Matching statistics: Unmatched nodes ',&
write(0,*) iam,'Matching statistics: Unmatched nodes ',&
& nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
end if

@ -313,22 +313,24 @@ subroutine s_mumps_solver_finalize(sv)
end subroutine s_mumps_solver_finalize
subroutine s_mumps_solver_descr(sv,info,iout,coarse)
subroutine s_mumps_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_s_mumps_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -337,8 +339,13 @@ subroutine s_mumps_solver_descr(sv,info,iout,coarse)
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' MUMPS Solver. '
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
call psb_erractionrestore(err_act)
return

@ -258,7 +258,7 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@ -269,6 +269,7 @@ module amg_s_onelev_mod
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
end subroutine amg_s_base_onelev_descr
end interface

@ -132,8 +132,6 @@ module amg_s_parmatch_aggregator_mod
type(psb_sspmat_type), allocatable :: prol, restr
type(psb_sspmat_type), allocatable :: ac, base_a, rwa
type(psb_desc_type), allocatable :: desc_ac, desc_ax, base_desc, rwdesc
integer(psb_ipk_) :: max_csize
integer(psb_ipk_) :: max_nlevels
logical :: reproducible_matching = .false.
logical :: need_symmetrize = .false.
logical :: unsmoothed_hierarchy = .true.
@ -392,18 +390,25 @@ contains
end function amg_s_parmatch_aggregator_sizeof
subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info)
subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_s_parmatch_aggregator_type), intent(in) :: ag
type(amg_sml_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,*) 'Parallel Matching Aggregator'
write(iout,*) ' Number of matching sweeps: ',ag%n_sweeps
write(iout,*) ' Matching algorithm : MatchBoxP (PREIS)'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps
write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_s_parmatch_aggregator_descr
@ -452,10 +457,10 @@ contains
& agnext%matching_alg = ag%matching_alg
if (.not.is_legal_nsweeps(agnext%n_sweeps))&
& agnext%n_sweeps = ag%n_sweeps
if (.not.is_legal_csize(agnext%max_csize))&
& agnext%max_csize = ag%max_csize
if (.not.is_legal_nlevels(agnext%max_nlevels))&
& agnext%max_nlevels = ag%max_nlevels
!!$ if (.not.is_legal_csize(agnext%max_csize))&
!!$ & agnext%max_csize = ag%max_csize
!!$ if (.not.is_legal_nlevels(agnext%max_nlevels))&
!!$ & agnext%max_nlevels = ag%max_nlevels
! Is this going to generate shallow copies/memory leaks/double frees?
! To be investigated further.
call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
@ -540,10 +545,6 @@ contains
case('AGGR_SIZE')
ag%orig_aggr_size = val
ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
case('PRMC_MAX_CSIZE')
ag%max_csize=val
case('PRMC_MAX_NLEVELS')
ag%max_nlevels=val
case('PRMC_W_SIZE')
call ag%bld_default_w(val)
case('PRMC_REPRODUCIBLE_MATCHING')
@ -569,8 +570,8 @@ contains
ag%matching_alg = 0
ag%n_sweeps = 1
ag%jacobi_sweeps = 0
ag%max_nlevels = 36
ag%max_csize = -1
!!$ ag%max_nlevels = 36
!!$ ag%max_csize = -1
!
! Apparently BootCMatch works better
! by keeping all entries

@ -155,15 +155,16 @@ module amg_s_prec_type
interface amg_precdescr
subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity)
subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity,prefix)
import :: amg_sprec_type, psb_ipk_
implicit none
! Arguments
class(amg_sprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
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
end subroutine amg_sfile_prec_descr
end interface

@ -385,20 +385,22 @@ contains
end subroutine s_slu_solver_finalize
subroutine s_slu_solver_descr(sv,info,iout,coarse)
subroutine s_slu_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_s_slu_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer :: err_act
character(len=20), parameter :: name='amg_s_slu_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -407,8 +409,13 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return

@ -88,16 +88,25 @@ contains
val = "Symmetric Decoupled aggregation"
end function amg_s_symdec_aggregator_fmt
subroutine amg_s_symdec_aggregator_descr(ag,parms,iout,info)
subroutine amg_s_symdec_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_s_symdec_aggregator_type), intent(in) :: ag
type(amg_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_s_symdec_aggregator_descr

@ -198,7 +198,7 @@ module amg_z_ainv_solver
!!$ end interface
interface
subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse)
subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
Implicit None
@ -208,7 +208,7 @@ module amg_z_ainv_solver
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_z_ainv_solver_descr
end interface

@ -396,21 +396,23 @@ contains
end subroutine z_as_smoother_default
subroutine z_as_smoother_descr(sm,info,iout,coarse)
subroutine z_as_smoother_descr(sm,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_z_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_as_smoother_descr'
integer(psb_ipk_) :: iout_
logical :: coarse_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -424,16 +426,21 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (.not.coarse_) then
write(iout_,*) ' Additive Schwarz with ',&
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
& sm%novr, ' overlap layers.'
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) ' Local solver:'
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) trim(prefix_), ' Local solver:'
endif
if (allocated(sm%sv)) then
call sm%sv%descr(info,iout_,coarse=coarse)
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
end if
call psb_erractionrestore(err_act)

@ -275,15 +275,22 @@ contains
val = .false.
end function amg_z_base_aggregator_xt_desc
subroutine amg_z_base_aggregator_descr(ag,parms,iout,info)
subroutine amg_z_base_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_z_base_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,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_z_base_aggregator_descr

@ -272,7 +272,7 @@ module amg_z_base_smoother_mod
end interface
interface
subroutine amg_z_base_smoother_descr(sm,info,iout,coarse)
subroutine amg_z_base_smoother_descr(sm,info,iout,coarse,prefix)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& amg_z_base_smoother_type, psb_ipk_
@ -281,6 +281,7 @@ module amg_z_base_smoother_mod
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_z_base_smoother_descr
end interface

@ -270,7 +270,7 @@ module amg_z_base_solver_mod
end interface
interface
subroutine amg_z_base_solver_descr(sv,info,iout,coarse)
subroutine amg_z_base_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& amg_z_base_solver_type, psb_ipk_
@ -281,7 +281,7 @@ module amg_z_base_solver_mod
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_z_base_solver_descr
end interface

@ -184,16 +184,23 @@ contains
val = "Decoupled aggregation"
end function amg_z_dec_aggregator_fmt
subroutine amg_z_dec_aggregator_descr(ag,parms,iout,info)
subroutine amg_z_dec_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_z_dec_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,*) 'Decoupled Aggregator'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_z_dec_aggregator_descr

@ -219,7 +219,7 @@ contains
end subroutine z_diag_solver_free
subroutine z_diag_solver_descr(sv,info,iout,coarse)
subroutine z_diag_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -228,11 +228,13 @@ contains
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_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@ -240,8 +242,13 @@ contains
else
iout_ = psb_out_unit
endif
write(iout_,*) ' Diagonal local solver '
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Diagonal local solver '
return
@ -352,7 +359,7 @@ module amg_z_l1_diag_solver
contains
subroutine z_l1_diag_solver_descr(sv,info,iout,coarse)
subroutine z_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -361,11 +368,13 @@ contains
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_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@ -373,8 +382,13 @@ contains
else
iout_ = psb_out_unit
endif
write(iout_,*) ' L1 Diagonal solver '
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
return

@ -433,20 +433,22 @@ contains
return
end subroutine z_gs_solver_free
subroutine z_gs_solver_descr(sv,info,iout,coarse)
subroutine z_gs_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_z_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_gs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -455,12 +457,17 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
@ -526,20 +533,22 @@ contains
val = .true.
end function z_gs_solver_is_iterative
subroutine z_bwgs_solver_descr(sv,info,iout,coarse)
subroutine z_bwgs_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_z_bwgs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_bwgs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -548,12 +557,17 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if

@ -157,7 +157,7 @@ contains
return
end subroutine z_id_solver_free
subroutine z_id_solver_descr(sv,info,iout,coarse)
subroutine z_id_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -165,12 +165,14 @@ contains
class(amg_z_id_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_id_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@ -178,8 +180,13 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' Identity local solver '
write(iout_,*) trim(prefix_), ' Identity local solver '
return

@ -406,7 +406,7 @@ contains
return
end subroutine z_ilu_solver_free
subroutine z_ilu_solver_descr(sv,info,iout,coarse)
subroutine z_ilu_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -414,12 +414,14 @@ contains
class(amg_z_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_ilu_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -428,15 +430,20 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' Incomplete factorization solver: ',&
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
& amg_fact_names(sv%fact_type)
select case(sv%fact_type)
case(psb_ilu_n_,psb_milu_n_)
write(iout_,*) ' Fill level:',sv%fill_in
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
case(psb_ilu_t_)
write(iout_,*) ' Fill level:',sv%fill_in
write(iout_,*) ' Fill threshold :',sv%thresh
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
end select
call psb_erractionrestore(err_act)

@ -123,7 +123,7 @@ module amg_z_invk_solver
end interface
interface
subroutine amg_z_invk_solver_descr(sv,info,iout,coarse)
subroutine amg_z_invk_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_dpk_, amg_z_invk_solver_type, psb_ipk_
Implicit None
@ -133,7 +133,7 @@ module amg_z_invk_solver
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_z_invk_solver_descr
end interface

@ -134,16 +134,17 @@ module amg_z_invt_solver
end interface
interface
subroutine amg_z_invt_solver_descr(sv,info,iout,coarse)
subroutine amg_z_invt_solver_descr(sv,info,iout,coarse,prefix)
import :: psb_dpk_, amg_z_invt_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_z_invt_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_z_invt_solver_descr
end interface

@ -219,12 +219,13 @@ module amg_z_jac_smoother
end interface
interface
subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse)
subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse,prefix)
import :: amg_z_jac_smoother_type, psb_ipk_
class(amg_z_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_z_jac_smoother_descr
end interface
@ -313,12 +314,13 @@ module amg_z_jac_smoother
end interface
interface
subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse)
subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
import :: amg_z_l1_jac_smoother_type, psb_ipk_
class(amg_z_l1_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_z_l1_jac_smoother_descr
end interface

@ -436,7 +436,7 @@ contains
val = "KRM solver"
end function z_krm_solver_get_fmt
subroutine z_krm_solver_descr(sv,info,iout,coarse)
subroutine z_krm_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
@ -444,12 +444,14 @@ contains
class(amg_z_krm_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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_krm_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -458,23 +460,22 @@ contains
else
iout_ = psb_out_unit
endif
if (sv%global) then
write(iout_,*) ' Krylov solver (global)'
if (present(prefix)) then
prefix_ = prefix
else
write(iout_,*) ' Krylov solver (local) '
prefix_ = ""
end if
write(iout_,*) ' method: ',sv%method
write(iout_,*) ' kprec: ',sv%kprec
if (sv%i_sub_solve > 0) then
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
if (sv%global) then
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
else
write(iout_,*) ' sub_solve: ',sv%sub_solve
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
end if
write(iout_,*) ' itmax: ',sv%itmax
write(iout_,*) ' eps: ',sv%eps
write(iout_,*) ' fillin: ',sv%fillin
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
call psb_erractionrestore(err_act)
return

@ -313,22 +313,24 @@ subroutine z_mumps_solver_finalize(sv)
end subroutine z_mumps_solver_finalize
subroutine z_mumps_solver_descr(sv,info,iout,coarse)
subroutine z_mumps_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_z_mumps_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
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
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -337,8 +339,13 @@ subroutine z_mumps_solver_descr(sv,info,iout,coarse)
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' MUMPS Solver. '
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
call psb_erractionrestore(err_act)
return

@ -257,7 +257,7 @@ module amg_z_onelev_mod
end interface
interface
subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@ -268,6 +268,7 @@ module amg_z_onelev_mod
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
end subroutine amg_z_base_onelev_descr
end interface

@ -155,15 +155,16 @@ module amg_z_prec_type
interface amg_precdescr
subroutine amg_zfile_prec_descr(prec,info,iout,root,verbosity)
subroutine amg_zfile_prec_descr(prec,info,iout,root,verbosity,prefix)
import :: amg_zprec_type, psb_ipk_
implicit none
! Arguments
class(amg_zprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
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
end subroutine amg_zfile_prec_descr
end interface

@ -385,20 +385,22 @@ contains
end subroutine z_slu_solver_finalize
subroutine z_slu_solver_descr(sv,info,iout,coarse)
subroutine z_slu_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_z_slu_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer :: err_act
character(len=20), parameter :: name='amg_z_slu_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -407,8 +409,13 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return

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

@ -88,16 +88,25 @@ contains
val = "Symmetric Decoupled aggregation"
end function amg_z_symdec_aggregator_fmt
subroutine amg_z_symdec_aggregator_descr(ag,parms,iout,info)
subroutine amg_z_symdec_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_z_symdec_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
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_z_symdec_aggregator_descr

@ -390,20 +390,22 @@ contains
end subroutine z_umf_solver_finalize
subroutine z_umf_solver_descr(sv,info,iout,coarse)
subroutine z_umf_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_z_umf_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer :: err_act
character(len=20), parameter :: name='amg_z_umf_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@ -412,8 +414,13 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) ' UMFPACK Sparse Factorization Solver. '
write(iout_,*) trim(prefix_), ' UMFPACK Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return

@ -67,22 +67,25 @@ OBJS=$(F90OBJS) $(COBJS) $(MPCOBJS)
LIBNAME=libamg_prec.a
objs: $(OBJS) aggrd levd smoothd solvd
lib: $(OBJS) aggrd levd smoothd solvd
cd aggregator && $(MAKE) lib
cd level && $(MAKE) lib
cd smoother && $(MAKE) lib
cd solver && $(MAKE) lib
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
$(RANLIB) $(HERE)/$(LIBNAME)
aggrd:
$(MAKE) -C aggregator
cd aggregator && $(MAKE) objs
levd:
$(MAKE) -C level
cd level && $(MAKE) objs
smoothd:
$(MAKE) -C smoother
cd smoother && $(MAKE) objs
solvd:
$(MAKE) -C solver
cd solver && $(MAKE) objs
mpobjs:
(make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)")
(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
veryclean: clean
/bin/rm -f $(LIBNAME)
@ -91,10 +94,10 @@ clean: solvclean smoothclean levclean aggrclean
/bin/rm -f $(OBJS) $(LOCAL_MODS)
aggrclean:
$(MAKE) -C aggregator clean
cd aggregator && $(MAKE) clean
levclean:
$(MAKE) -C level clean
cd level && $(MAKE) clean
smoothclean:
$(MAKE) -C smoother clean
cd smoother && $(MAKE) clean
solvclean:
$(MAKE) -C solver clean
cd solver && $(MAKE) clean

@ -70,13 +70,31 @@ amg_d_newmatch_spmm_bld_ov.o
MPCXXOBJS=MatchBoxPC.o \
algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o \
newmatch_interface.o
newmatch_interface.o \
sendBundledMessages.o \
initialize.o \
extractUChunk.o \
isAlreadyMatched.o \
findOwnerOfGhost.o \
clean.o \
computeCandidateMate.o \
parallelComputeCandidateMateB.o \
processMatchedVertices.o \
processMatchedVerticesAndSendMessages.o \
processCrossEdge.o \
queueTransfer.o \
processMessages.o \
processExposedVertex.o \
algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.o \
MatchingAlgorithms.o
OBJS = $(FOBJS) $(MPCOBJS) $(MPCXXOBJS)
LIBNAME=libamg_prec.a
lib: $(OBJS)
objs: $(OBJS)
lib: objs
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
$(RANLIB) $(HERE)/$(LIBNAME)

@ -60,17 +60,43 @@ void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
#if !defined(SERIAL_MPI)
MPI_Comm C_comm=MPI_Comm_f2c(icomm);
#ifdef DEBUG
fprintf(stderr,"MatchBoxPC: rank %d nlver %ld nledge %ld [ %ld %ld ]\n",
myRank,NLVer, NLEdge,verDistance[0],verDistance[1]);
#endif
dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(NLVer, NLEdge,
#define TIME_TRACKER
#ifdef TIME_TRACKER
double tmr = MPI_Wtime();
#endif
#define OMP
#ifdef OMP
dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(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
dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(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
#ifdef TIME_TRACKER
tmr = MPI_Wtime() - tmr;
fprintf(stderr, "Elaboration time: %f for %ld nodes\n", tmr, NLVer);
#endif
#endif
}

@ -52,145 +52,412 @@
#ifndef _matchboxpC_H_
#define _matchboxpC_H_
//Turn on a lot of debugging information with this switch:
// Turn on a lot of debugging information with this switch:
//#define PRINT_DEBUG_INFO_
#include <stdio.h>
#include <iostream>
#include <assert.h>
#include <map>
#include <vector>
// #include "matchboxp.h"
#include "omp.h"
#include "primitiveDataTypeDefinitions.h"
#include "dataStrStaticQueue.h"
using namespace std;
const int NUM_THREAD = 4;
const int UCHUNK = 10;
const MilanLongInt REQUEST = 1;
const MilanLongInt SUCCESS = 2;
const MilanLongInt FAILURE = 3;
const MilanLongInt SIZEINFO = 4;
const int ComputeTag = 7; // Predefined tag
const int BundleTag = 9; // Predefined tag
static vector<MilanLongInt> DEFAULT_VECTOR;
// MPI type map
template <typename T>
MPI_Datatype TypeMap();
template <>
inline MPI_Datatype TypeMap<int64_t>() { return MPI_LONG_LONG; }
template <>
inline MPI_Datatype TypeMap<int>() { return MPI_INT; }
template <>
inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
template <>
inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
#ifdef __cplusplus
extern "C" {
extern "C"
{
#endif
#if !defined(SERIAL_MPI)
#define MilanMpiLongInt MPI_LONG_LONG
#define MilanMpiLongInt MPI_LONG_LONG
#ifndef _primitiveDataType_Definition_
#define _primitiveDataType_Definition_
//Regular integer:
#ifndef INTEGER_H
#define INTEGER_H
typedef int32_t MilanInt;
#endif
//Regular long integer:
#ifndef LONG_INT_H
#define LONG_INT_H
#ifdef BIT64
typedef int64_t MilanLongInt;
typedef MPI_LONG MilanMpiLongInt;
#else
typedef int32_t MilanLongInt;
typedef MPI_INT MilanMpiLongInt;
#endif
#endif
//Regular boolean
#ifndef BOOL_H
#define BOOL_H
typedef bool MilanBool;
#endif
//Regular double and absolute value computation:
#ifndef REAL_H
#define REAL_H
typedef double MilanReal;
typedef MPI_DOUBLE MilanMpiReal;
inline MilanReal MilanAbs(MilanReal value)
{
return fabs(value);
}
#endif
//Regular float and absolute value computation:
#ifndef FLOAT_H
#define FLOAT_H
typedef float MilanFloat;
typedef MPI_FLOAT MilanMpiFloat;
inline MilanFloat MilanAbsFloat(MilanFloat value)
{
return fabs(value);
}
#endif
//// Define the limits:
#ifndef LIMITS_H
#define LIMITS_H
//Integer Maximum and Minimum:
// #define MilanIntMax INT_MAX
// #define MilanIntMin INT_MIN
#define MilanIntMax INT32_MAX
#define MilanIntMin INT32_MIN
#ifdef BIT64
#define MilanLongIntMax INT64_MAX
#define MilanLongIntMin -INT64_MAX
#else
#define MilanLongIntMax INT32_MAX
#define MilanLongIntMin -INT32_MAX
#endif
#endif
// Regular integer:
#ifndef INTEGER_H
#define INTEGER_H
typedef int32_t MilanInt;
#endif
// Regular long integer:
#ifndef LONG_INT_H
#define LONG_INT_H
#ifdef BIT64
typedef int64_t MilanLongInt;
typedef MPI_LONG MilanMpiLongInt;
#else
typedef int32_t MilanLongInt;
typedef MPI_INT MilanMpiLongInt;
#endif
#endif
// Regular boolean
#ifndef BOOL_H
#define BOOL_H
typedef bool MilanBool;
#endif
// Regular double and absolute value computation:
#ifndef REAL_H
#define REAL_H
typedef double MilanReal;
typedef MPI_DOUBLE MilanMpiReal;
inline MilanReal MilanAbs(MilanReal value)
{
return fabs(value);
}
#endif
// Regular float and absolute value computation:
#ifndef FLOAT_H
#define FLOAT_H
typedef float MilanFloat;
typedef MPI_FLOAT MilanMpiFloat;
inline MilanFloat MilanAbsFloat(MilanFloat value)
{
return fabs(value);
}
#endif
//// Define the limits:
#ifndef LIMITS_H
#define LIMITS_H
// Integer Maximum and Minimum:
// #define MilanIntMax INT_MAX
// #define MilanIntMin INT_MIN
#define MilanIntMax INT32_MAX
#define MilanIntMin INT32_MIN
#ifdef BIT64
#define MilanLongIntMax INT64_MAX
#define MilanLongIntMin -INT64_MAX
#else
#define MilanLongIntMax INT32_MAX
#define MilanLongIntMin -INT32_MAX
#endif
#endif
// +INFINITY
const double PLUS_INFINITY = numeric_limits<int>::infinity();
const double MINUS_INFINITY = -PLUS_INFINITY;
//#define MilanRealMax LDBL_MAX
#define MilanRealMax PLUS_INFINITY
#define MilanRealMin MINUS_INFINITY
//#define MilanRealMax LDBL_MAX
#define MilanRealMax PLUS_INFINITY
#define MilanRealMin MINUS_INFINITY
#endif
//Function of find the owner of a ghost vertex using binary search:
inline MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
MilanInt myRank, MilanInt numProcs);
void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC
(
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 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 );
void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight,
MilanLongInt* verDistance,
MilanLongInt* Mate,
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
MilanLongInt* ph1_card, MilanLongInt* ph2_card );
void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight,
MilanLongInt* verDistance,
MilanLongInt* Mate,
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
MilanLongInt* ph1_card, MilanLongInt* ph2_card );
// Function of find the owner of a ghost vertex using binary search:
MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
MilanInt myRank, MilanInt numProcs);
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 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 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,
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 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);
void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
MilanLongInt *verDistance,
MilanLongInt *Mate,
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
MilanLongInt *ph1_card, MilanLongInt *ph2_card);
void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanFloat *edgeLocWeight,
MilanLongInt *verDistance,
MilanLongInt *Mate,
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
MilanLongInt *ph1_card, MilanLongInt *ph2_card);
#endif
#ifdef __cplusplus

@ -72,12 +72,6 @@
#ifdef SERIAL_MPI
#else
//MPI type map
template<typename T> MPI_Datatype TypeMap();
template<> inline MPI_Datatype TypeMap<int64_t>() { return MPI_LONG_LONG; }
template<> inline MPI_Datatype TypeMap<int>() { return MPI_INT; }
template<> inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
template<> inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
// DOUBLE PRECISION VERSION
//WARNING: The vertex block on a given rank is contiguous

@ -0,0 +1,554 @@
#include "MatchBoxPC.h"
// ***********************************************************************
//
// MatchboxP: A C++ library for approximate weighted matching
// Mahantesh Halappanavar (hala@pnnl.gov)
// Pacific Northwest National Laboratory
//
// ***********************************************************************
//
// Copyright (2021) Battelle Memorial Institute
// All rights reserved.
//
// 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. Neither the name of the copyright holder nor the names of its
// contributors may be used to endorse or promote products derived from
// this software without specific prior written permission.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
// "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
// LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
// FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
// COPYRIGHT HOLDER OR 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.
//
// ************************************************************************
//////////////////////////////////////////////////////////////////////////////////////
/////////////////////////// DOMINATING EDGES MODEL ///////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////
/* Function : algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMate()
*
* Date : New update: Feb 17, 2019, Richland, Washington.
* Date : Original development: May 17, 2009, E&CS Bldg.
*
* Purpose : Compute Approximate Maximum Weight Matching in Linear Time
*
* Args : inputMatrix - instance of Compressed-Col format of Matrix
* Mate - The Mate array
*
* Returns : By Value: (void)
* By Reference: Mate
*
* Comments : 1/2 Approx Algorithm. Picks the locally available heaviest edge.
* Assumption: The Mate Array is empty.
*/
/*
NLVer = #of vertices, NLEdge = #of edges
CSR/CSC/Compressed format: verLocPtr = Pointer, verLocInd = Index, edgeLocWeight = edge weights (positive real numbers)
verDistance = A vector of size |P|+1 containing the cumulative number of vertices per process
Mate = A vector of size |V_p| (local subgraph) to store the output (matching)
MPI: myRank, numProcs, comm,
Statistics: msgIndSent, msgActualSent, msgPercent : Size: |P| number of processes in the comm-world
Statistics: ph0_time, ph1_time, ph2_time: Runtimes
Statistics: ph1_card, ph2_card : Size: |P| number of processes in the comm-world (number of matched edges in Phase 1 and Phase 2)
*/
//#define DEBUG_HANG_
#ifdef SERIAL_MPI
#else
// DOUBLE PRECISION VERSION
// WARNING: The vertex block on a given rank is contiguous
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)
{
/*
* 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
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;
MilanLongInt msgActual = 0, msgInd = 0;
MilanReal 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;
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++)
PCounter[i] = 0;
MilanLongInt NumMessagesBundled = 0;
// TODO when the last computational section will be refactored this could be eliminated
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;
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<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...";
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_B(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_B(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);
processMatchedVertices(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 //////////////////////////////
///////////////////////////////////////////////////////////////////////////////////
processMatchedVerticesAndSendMessages(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 //////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////
processMessages(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
}
// End of algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMate
#endif
#endif

@ -97,6 +97,8 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
integer(psb_ipk_), save :: idx_map_bld=-1, idx_map_tprol=-1
logical, parameter :: do_timings=.false.
name='amg_c_dec_aggregator_tprol'
call psb_erractionsave(err_act)
@ -108,6 +110,10 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
info = psb_success_
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
if ((do_timings).and.(idx_map_bld==-1)) &
& idx_map_bld = psb_get_timer_idx("DEC_TPROL: map_bld")
if ((do_timings).and.(idx_map_tprol==-1)) &
& idx_map_tprol = psb_get_timer_idx("DEC_TPROL: map_tprol")
call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle)
@ -121,10 +127,14 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
! The decoupled aggregator based on SOC measures ignores
! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
!
if (do_timings) call psb_tic(idx_map_bld)
clean_zeros = ag%do_clean_zeros
call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
if (do_timings) call psb_toc(idx_map_bld)
if (do_timings) call psb_tic(idx_map_tprol)
if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
if (do_timings) call psb_toc(idx_map_tprol)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')

@ -140,6 +140,9 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
real(psb_spk_) :: anorm, omega, tmp, dg, theta
logical, parameter :: debug_new=.false.
character(len=80) :: filename
logical, parameter :: do_timings=.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
name='amg_aggrmat_smth_bld'
info=psb_success_
@ -153,6 +156,23 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if ((do_timings).and.(idx_spspmm==-1)) &
& idx_spspmm = psb_get_timer_idx("DEC_SMTH_BLD: par_spspmm")
if ((do_timings).and.(idx_phase1==-1)) &
& idx_phase1 = psb_get_timer_idx("DEC_SMTH_BLD: phase1 ")
if ((do_timings).and.(idx_phase2==-1)) &
& idx_phase2 = psb_get_timer_idx("DEC_SMTH_BLD: phase2 ")
if ((do_timings).and.(idx_phase3==-1)) &
& idx_phase3 = psb_get_timer_idx("DEC_SMTH_BLD: phase3 ")
if ((do_timings).and.(idx_gtrans==-1)) &
& idx_gtrans = psb_get_timer_idx("DEC_SMTH_BLD: gtrans ")
if ((do_timings).and.(idx_refine==-1)) &
& idx_refine = psb_get_timer_idx("DEC_SMTH_BLD: refine ")
if ((do_timings).and.(idx_cdasb==-1)) &
& idx_cdasb = psb_get_timer_idx("DEC_SMTH_BLD: cdasb ")
if ((do_timings).and.(idx_ptap==-1)) &
& idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld ")
nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows()
@ -171,6 +191,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
! naggr: number of local aggregates
! nrow: local rows.
!
if (do_timings) call psb_tic(idx_phase1)
! Get the diagonal D
adiag = a%get_diag(info)
@ -196,7 +217,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
!
! Build the filtered matrix Af from A
!
!$OMP parallel do private(i,j,tmp,jd) schedule(static)
do i=1, nrow
tmp = czero
jd = -1
@ -214,11 +235,13 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
acsrf%val(jd)=acsrf%val(jd)-tmp
end if
enddo
!$OMP end parallel do
! Take out zeroed terms
call acsrf%clean_zeros(info)
end if
!$OMP parallel do private(i) schedule(static)
do i=1,size(adiag)
if (adiag(i) /= czero) then
adiag(i) = cone / adiag(i)
@ -226,7 +249,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
adiag(i) = cone
end if
end do
!$OMP end parallel do
if (parms%aggr_omega_alg == amg_eig_est_) then
if (parms%aggr_eig == amg_max_norm_) then
@ -252,8 +275,9 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
call psb_errpush(info,name,a_err='invalid amg_aggr_omega_alg_')
goto 9999
end if
if (do_timings) call psb_toc(idx_phase1)
if (do_timings) call psb_tic(idx_phase2)
call acsrf%scal(adiag,info)
if (info /= psb_success_) goto 9999
@ -267,6 +291,8 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
call psb_cdasb(desc_ac,info)
call psb_cd_reinit(desc_ac,info)
if (do_timings) call psb_toc(idx_phase2)
if (do_timings) call psb_tic(idx_phase3)
!
! Build the smoothed prolongator using either A or Af
! acsr1 = (I-w*D*A) Prol acsr1 = (I-w*D*Af) Prol
@ -279,8 +305,8 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
goto 9999
end if
if (do_timings) call psb_toc(idx_phase3)
if (do_timings) call psb_tic(idx_ptap)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done SPSPMM 1'
@ -292,7 +318,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
call op_prol%mv_from(coo_prol)
call op_restr%mv_from(coo_restr)
if (do_timings) call psb_toc(idx_ptap)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done smooth_aggregate '

Some files were not shown because too many files have changed in this diff Show More

Loading…
Cancel
Save