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 Changelog. A lot less detailed than usual, at least for past
history. 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/28: Fix interface to MUMPS and configry machinery. Require PSB 3.6.
2018/10/10: ICTXT argument in prec%init(). 2018/10/10: ICTXT argument in prec%init().
2018/07/30: Fixes for Intel compilers. BootCMatch interface in examples. 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 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 Salvatore Filippone
Pasqua D'Ambra Pasqua D'Ambra

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

@ -1,6 +1,5 @@
AMG4PSBLAS 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) Salvatore Filippone (University of Rome Tor Vergata and IAC-CNR)
Pasqua D'Ambra (IAC-CNR, Naples, IT) Pasqua D'Ambra (IAC-CNR, Naples, IT)

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

@ -64,7 +64,7 @@ module amg_base_prec_type
! !
use psb_const_mod use psb_const_mod
use psb_base_mod, only :& 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_ipk_, psb_dpk_, psb_spk_, psb_epk_, &
& psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, & & psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, &
& psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,& & psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,&
@ -81,9 +81,9 @@ module amg_base_prec_type
! !
! Version numbers ! 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_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 integer(psb_ipk_), parameter :: amg_patchlevel_ = 0
type amg_ml_parms type amg_ml_parms
@ -656,43 +656,52 @@ contains
end if end if
end subroutine ml_parms_mlcycledsc end subroutine ml_parms_mlcycledsc
subroutine ml_parms_mldescr(pm,iout,info) subroutine ml_parms_mldescr(pm,iout,info,prefix)
Implicit None Implicit None
! Arguments ! Arguments
class(amg_ml_parms), intent(in) :: pm class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
info = psb_success_ 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 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) & 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) & aggr_type_names(pm%aggr_type)
!if (pm%par_aggr_alg /= amg_ext_aggr_) then !if (pm%par_aggr_alg /= amg_ext_aggr_) then
if ( pm%aggr_ord /= amg_aggr_ord_nat_) & 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) & ord_names(pm%aggr_ord)
write(iout,*) ' Aggregation prolongator: ', & write(iout,*) trim(prefix),' Aggregation prolongator: ', &
& aggr_prols(pm%aggr_prol) & aggr_prols(pm%aggr_prol)
if (pm%aggr_prol /= amg_no_smooth_) then 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 if (pm%aggr_omega_alg == amg_eig_est_) then
write(iout,*) ' Damping omega computation: spectral radius estimate' write(iout,*) trim(prefix),' Damping omega computation: spectral radius estimate'
write(iout,*) ' Spectral radius estimate: ', & write(iout,*) trim(prefix),' Spectral radius estimate: ', &
& eigen_estimates(pm%aggr_eig) & eigen_estimates(pm%aggr_eig)
else if (pm%aggr_omega_alg == amg_user_choice_) then 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 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 end if
!end if !end if
else else
write(iout,*) ' Multilevel type: Unkonwn value. Something is amiss....',& write(iout,*) trim(prefix),' Multilevel type: Unkonwn value. Something is amiss....',&
& pm%ml_cycle & pm%ml_cycle
end if end if
@ -700,15 +709,16 @@ contains
end subroutine ml_parms_mldescr end subroutine ml_parms_mldescr
subroutine ml_parms_descr(pm,iout,info,coarse) subroutine ml_parms_descr(pm,iout,info,coarse,prefix)
Implicit None Implicit None
! Arguments ! Arguments
class(amg_ml_parms), intent(in) :: pm class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical :: coarse_ logical :: coarse_
info = psb_success_ info = psb_success_
@ -719,7 +729,7 @@ contains
end if end if
if (coarse_) then if (coarse_) then
call pm%coarsedescr(iout,info) call pm%coarsedescr(iout,info,prefix=prefix)
end if end if
return return
@ -727,81 +737,126 @@ contains
end subroutine ml_parms_descr end subroutine ml_parms_descr
subroutine ml_parms_coarsedescr(pm,iout,info) subroutine ml_parms_coarsedescr(pm,iout,info,prefix)
Implicit None Implicit None
! Arguments ! Arguments
class(amg_ml_parms), intent(in) :: pm class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
info = psb_success_ 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) & matrix_names(pm%coarse_mat)
select case(pm%coarse_solve) select case(pm%coarse_solve)
case (amg_bjac_,amg_as_) case (amg_bjac_,amg_as_)
write(iout,*) ' Number of sweeps : ',& write(iout,*) trim(prefix),' Coarse solver: ',&
& pm%sweeps_pre
write(iout,*) ' Coarse solver: ',&
& 'Block Jacobi' & 'Block Jacobi'
case (amg_l1_bjac_) write(iout,*) trim(prefix),' Number of sweeps : ',&
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_pre & pm%sweeps_pre
write(iout,*) ' Coarse solver: ',& case (amg_l1_bjac_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'L1-Block Jacobi' & 'L1-Block Jacobi'
case (amg_jac_) write(iout,*) trim(prefix),' Number of sweeps : ',&
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_pre & pm%sweeps_pre
write(iout,*) ' Coarse solver: ',& case (amg_jac_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'Point Jacobi' & '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 case default
write(iout,*) ' Coarse solver: ',& write(iout,*) trim(prefix),' Coarse solver: ',&
& amg_fact_names(pm%coarse_solve) & amg_fact_names(pm%coarse_solve)
end select end select
end subroutine ml_parms_coarsedescr 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 Implicit None
! Arguments ! Arguments
class(amg_sml_parms), intent(in) :: pm class(amg_sml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
info = psb_success_ 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 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 end if
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh
return return
end subroutine s_ml_parms_descr 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 Implicit None
! Arguments ! Arguments
class(amg_dml_parms), intent(in) :: pm class(amg_dml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
info = psb_success_ 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 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 end if
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh
return return

@ -198,7 +198,7 @@ module amg_c_ainv_solver
!!$ end interface !!$ end interface
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_ import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
Implicit None Implicit None
@ -208,7 +208,7 @@ module amg_c_ainv_solver
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_ainv_solver_descr end subroutine amg_c_ainv_solver_descr
end interface end interface

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

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

@ -272,7 +272,7 @@ module amg_c_base_smoother_mod
end interface end interface
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, & import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_smoother_type, psb_ipk_ & 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_base_smoother_descr end subroutine amg_c_base_smoother_descr
end interface end interface

@ -270,7 +270,7 @@ module amg_c_base_solver_mod
end interface end interface
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, & import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_solver_type, psb_ipk_ & 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_base_solver_descr end subroutine amg_c_base_solver_descr
end interface end interface

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

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

@ -433,20 +433,22 @@ contains
return return
end subroutine c_gs_solver_free 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 Implicit None
! Arguments ! Arguments
class(amg_c_gs_solver_type), intent(in) :: sv class(amg_c_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_gs_solver_descr' character(len=20), parameter :: name='amg_c_gs_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -455,12 +457,17 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then 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' & sv%sweeps,' sweeps'
else 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 & sv%eps,' and maxit', sv%sweeps
end if end if
@ -526,20 +533,22 @@ contains
val = .true. val = .true.
end function c_gs_solver_is_iterative 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 Implicit None
! Arguments ! Arguments
class(amg_c_bwgs_solver_type), intent(in) :: sv class(amg_c_bwgs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_bwgs_solver_descr' character(len=20), parameter :: name='amg_c_bwgs_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -548,12 +557,17 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then 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' & sv%sweeps,' sweeps'
else 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 & sv%eps,' and maxit', sv%sweeps
end if end if

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

@ -406,7 +406,7 @@ contains
return return
end subroutine c_ilu_solver_free 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 Implicit None
@ -414,12 +414,14 @@ contains
class(amg_c_ilu_solver_type), intent(in) :: sv class(amg_c_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_ilu_solver_descr' character(len=20), parameter :: name='amg_c_ilu_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -428,15 +430,20 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif 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) & amg_fact_names(sv%fact_type)
select case(sv%fact_type) select case(sv%fact_type)
case(psb_ilu_n_,psb_milu_n_) 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_) case(psb_ilu_t_)
write(iout_,*) ' Fill level:',sv%fill_in write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
write(iout_,*) ' Fill threshold :',sv%thresh write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
end select end select
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

@ -123,7 +123,7 @@ module amg_c_invk_solver
end interface end interface
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_ import :: psb_spk_, amg_c_invk_solver_type, psb_ipk_
Implicit None Implicit None
@ -133,7 +133,7 @@ module amg_c_invk_solver
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_invk_solver_descr end subroutine amg_c_invk_solver_descr
end interface end interface

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

@ -219,12 +219,13 @@ module amg_c_jac_smoother
end interface end interface
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_ import :: amg_c_jac_smoother_type, psb_ipk_
class(amg_c_jac_smoother_type), intent(in) :: sm class(amg_c_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 subroutine amg_c_jac_smoother_descr
end interface end interface
@ -313,12 +314,13 @@ module amg_c_jac_smoother
end interface end interface
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_ import :: amg_c_l1_jac_smoother_type, psb_ipk_
class(amg_c_l1_jac_smoother_type), intent(in) :: sm class(amg_c_l1_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_l1_jac_smoother_descr end subroutine amg_c_l1_jac_smoother_descr
end interface end interface

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

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

@ -257,7 +257,7 @@ module amg_c_onelev_mod
end interface end interface
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, & import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, & & psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_c_base_onelev_descr end subroutine amg_c_base_onelev_descr
end interface end interface

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

@ -385,20 +385,22 @@ contains
end subroutine c_slu_solver_finalize 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 Implicit None
! Arguments ! Arguments
class(amg_c_slu_solver_type), intent(in) :: sv class(amg_c_slu_solver_type), intent(in) :: sv
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables ! Local variables
integer :: err_act integer :: err_act
character(len=20), parameter :: name='amg_c_slu_solver_descr' character(len=20), parameter :: name='amg_c_slu_solver_descr'
integer :: iout_ integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -407,8 +409,13 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif 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) call psb_erractionrestore(err_act)
return return

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

@ -198,7 +198,7 @@ module amg_d_ainv_solver
!!$ end interface !!$ end interface
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_ import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
Implicit None Implicit None
@ -208,7 +208,7 @@ module amg_d_ainv_solver
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_ainv_solver_descr end subroutine amg_d_ainv_solver_descr
end interface end interface

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

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

@ -272,7 +272,7 @@ module amg_d_base_smoother_mod
end interface end interface
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, & import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_smoother_type, psb_ipk_ & 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_base_smoother_descr end subroutine amg_d_base_smoother_descr
end interface end interface

@ -270,7 +270,7 @@ module amg_d_base_solver_mod
end interface end interface
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, & import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_solver_type, psb_ipk_ & 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_base_solver_descr end subroutine amg_d_base_solver_descr
end interface end interface

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

@ -496,23 +496,23 @@ contains
! !
! Now call matching! ! 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) if (do_timings) call psb_tic(idx_cmboxp)
info = dnew_Match_If(ipar,matching,lambda,nr,c_loc(tcsr%irp),c_loc(tcsr%ja),& 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)) & c_loc(tcsr%val),c_loc(diag),c_loc(w),c_loc(mate))
if (do_timings) call psb_toc(idx_cmboxp) 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 if (debug_sync) then
call psb_max(ictxt,info) call psb_max(ictxt,info)
if (iam == 0) write(0,*)' done PMatchBox', info if (iam == 0) write(0,*)' done NewMatch', info
end if end if
if (do_timings) call psb_tic(idx_phase3) if (do_timings) call psb_tic(idx_phase3)
nunmatch = count(mate(1:nr)<=0) nunmatch = count(mate(1:nr)<=0)
! call psb_sum(ictxt,nunmatch) ! call psb_sum(ictxt,nunmatch)
if (nunmatch /= 0) write(0,*) iam,' Unmatched nodes local imbalance ',nunmatch !if (nunmatch /= 0) write(0,*) iam,' Unmatched nodes local imbalance ',nunmatch
! if (count(mate(1:nr)<0) /= nunmatch) write(0,*) iam,' Matching results ?',& ! if (count(mate(1:nr)<0) /= nunmatch) write(0,*) iam,' Matching results ?',&
! & nunmatch, count(mate(1:nr)<0) ! & nunmatch, count(mate(1:nr)<0)
if (debug_sync) then if (debug_sync) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (iam == 0) write(0,*)' done build_matching ' if (iam == 0) write(0,*)' done build_matching '

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

@ -433,20 +433,22 @@ contains
return return
end subroutine d_gs_solver_free 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 Implicit None
! Arguments ! Arguments
class(amg_d_gs_solver_type), intent(in) :: sv class(amg_d_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_gs_solver_descr' character(len=20), parameter :: name='amg_d_gs_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -455,12 +457,17 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then 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' & sv%sweeps,' sweeps'
else 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 & sv%eps,' and maxit', sv%sweeps
end if end if
@ -526,20 +533,22 @@ contains
val = .true. val = .true.
end function d_gs_solver_is_iterative 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 Implicit None
! Arguments ! Arguments
class(amg_d_bwgs_solver_type), intent(in) :: sv class(amg_d_bwgs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_bwgs_solver_descr' character(len=20), parameter :: name='amg_d_bwgs_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -548,12 +557,17 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then 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' & sv%sweeps,' sweeps'
else 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 & sv%eps,' and maxit', sv%sweeps
end if end if

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

@ -406,7 +406,7 @@ contains
return return
end subroutine d_ilu_solver_free 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 Implicit None
@ -414,12 +414,14 @@ contains
class(amg_d_ilu_solver_type), intent(in) :: sv class(amg_d_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_ilu_solver_descr' character(len=20), parameter :: name='amg_d_ilu_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -428,15 +430,20 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif 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) & amg_fact_names(sv%fact_type)
select case(sv%fact_type) select case(sv%fact_type)
case(psb_ilu_n_,psb_milu_n_) 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_) case(psb_ilu_t_)
write(iout_,*) ' Fill level:',sv%fill_in write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
write(iout_,*) ' Fill threshold :',sv%thresh write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
end select end select
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

@ -123,7 +123,7 @@ module amg_d_invk_solver
end interface end interface
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_ import :: psb_dpk_, amg_d_invk_solver_type, psb_ipk_
Implicit None Implicit None
@ -133,7 +133,7 @@ module amg_d_invk_solver
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_invk_solver_descr end subroutine amg_d_invk_solver_descr
end interface end interface

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

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

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

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

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

@ -329,17 +329,24 @@ contains
val = "new matching aggregation" val = "new matching aggregation"
end function d_newmatch_aggregator_fmt 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 implicit none
class(amg_d_newmatch_aggregator_type), intent(in) :: ag class(amg_d_newmatch_aggregator_type), intent(in) :: ag
type(amg_dml_parms), intent(in) :: parms type(amg_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info 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,*) trim(prefix_),' ','NewMatch Aggregator'
write(iout,*) ' Number of Matching sweeps: ',ag%n_sweeps write(iout,*) trim(prefix_),' ',' Number of Matching sweeps: ',ag%n_sweeps
write(iout,*) ' Matching algorithm : ',ag%matching_alg write(iout,*) trim(prefix_),' ',' Matching algorithm : ',ag%matching_alg
write(iout,*) 'Aggregator object type: ',ag%fmt() write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info) call parms%mldescr(iout,info)
return return

@ -259,7 +259,7 @@ module amg_d_onelev_mod
end interface end interface
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, & import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, & & psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_d_base_onelev_descr end subroutine amg_d_base_onelev_descr
end interface end interface

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

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

@ -385,20 +385,22 @@ contains
end subroutine d_slu_solver_finalize 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 Implicit None
! Arguments ! Arguments
class(amg_d_slu_solver_type), intent(in) :: sv class(amg_d_slu_solver_type), intent(in) :: sv
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables ! Local variables
integer :: err_act integer :: err_act
character(len=20), parameter :: name='amg_d_slu_solver_descr' character(len=20), parameter :: name='amg_d_slu_solver_descr'
integer :: iout_ integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -407,8 +409,13 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif 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) call psb_erractionrestore(err_act)
return return

@ -52,7 +52,7 @@ module amg_d_sludist_solver
use iso_c_binding use iso_c_binding
use amg_d_base_solver_mod 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 type, extends(amg_d_base_solver_type) :: amg_d_sludist_solver_type
@ -270,10 +270,12 @@ contains
! Local variables ! Local variables
type(psb_dspmat_type) :: atmp type(psb_dspmat_type) :: atmp
type(psb_d_csr_sparse_mat) :: acsr 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 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 character(len=20) :: name='d_sludist_solver_bld', ch_err
info=psb_success_ info=psb_success_
@ -293,19 +295,36 @@ contains
n_col = desc_a%get_local_cols() n_col = desc_a%get_local_cols()
nglob = desc_a%get_global_rows() 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 psb_rwextd(n_row,atmp,info,b=b)
call atmp%cscnv(info,type='csr',dupl=psb_dupl_add_)
call atmp%mv_to(acsr) call atmp%mv_to(acsr)
nrow_a = acsr%get_nrows() nrow_a = acsr%get_nrows()
nztota = acsr%get_nzeros() nztota = acsr%get_nzeros()
call psb_loc_to_glob(ione,lfrst,desc_a,info)
! Fix the entries to call C-base SuperLU ! Fix the entries to call C-base SuperLU
call psb_loc_to_glob(1,ifrst,desc_a,info) call psb_realloc(nztota,gja,info)
call psb_loc_to_glob(nrow_a,ibcheck,desc_a,info) call psb_loc_to_glob(acsr%ja(1:nztota),gja(1:nztota), desc_a, info, iact='I')
call psb_loc_to_glob(acsr%ja(1:nztota),desc_a,info,iact='I') acsr%ja(1:nztota) = gja(1:nztota)
acsr%ja(:) = acsr%ja(:) - 1 acsr%ja(:) = acsr%ja(:) - 1
acsr%irp(:) = acsr%irp(:) - 1 acsr%irp(:) = acsr%irp(:) - 1
ifrst = ifrst - 1 ifrst = lfrst - 1
info = amg_dsludist_fact(nglob,nrow_a,nztota,ifrst,& info = amg_dsludist_fact(nglob,nrow_a,nztota,ifrst,&
& acsr%val,acsr%irp,acsr%ja,sv%lufactors,& & acsr%val,acsr%irp,acsr%ja,sv%lufactors,&
& npr,npc) & npr,npc)
@ -318,7 +337,6 @@ contains
end if end if
call acsr%free() call acsr%free()
call atmp%free()
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' end' & write(debug_unit,*) me,' ',trim(name),' end'
@ -403,15 +421,16 @@ contains
end subroutine d_sludist_solver_finalize 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 Implicit None
! Arguments ! Arguments
class(amg_d_sludist_solver_type), intent(in) :: sv class(amg_d_sludist_solver_type), intent(in) :: sv
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables ! Local variables
integer :: err_act integer :: err_act
@ -419,6 +438,7 @@ contains
integer :: me, np integer :: me, np
character(len=20), parameter :: name='amg_d_sludist_solver_descr' character(len=20), parameter :: name='amg_d_sludist_solver_descr'
integer :: iout_ integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -427,8 +447,13 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif 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) call psb_erractionrestore(err_act)
return return

@ -88,16 +88,25 @@ contains
val = "Symmetric Decoupled aggregation" val = "Symmetric Decoupled aggregation"
end function amg_d_symdec_aggregator_fmt 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 implicit none
class(amg_d_symdec_aggregator_type), intent(in) :: ag class(amg_d_symdec_aggregator_type), intent(in) :: ag
type(amg_dml_parms), intent(in) :: parms type(amg_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
write(iout,*) 'Decoupled Aggregator locally-symmetrized' character(1024) :: prefix_
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info) 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 return
end subroutine amg_d_symdec_aggregator_descr end subroutine amg_d_symdec_aggregator_descr

@ -390,20 +390,22 @@ contains
end subroutine d_umf_solver_finalize 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 Implicit None
! Arguments ! Arguments
class(amg_d_umf_solver_type), intent(in) :: sv class(amg_d_umf_solver_type), intent(in) :: sv
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables ! Local variables
integer :: err_act integer :: err_act
character(len=20), parameter :: name='amg_d_umf_solver_descr' character(len=20), parameter :: name='amg_d_umf_solver_descr'
integer :: iout_ integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -412,8 +414,13 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif 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) call psb_erractionrestore(err_act)
return return

@ -198,7 +198,7 @@ module amg_s_ainv_solver
!!$ end interface !!$ end interface
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_ import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
Implicit None Implicit None
@ -208,7 +208,7 @@ module amg_s_ainv_solver
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_ainv_solver_descr end subroutine amg_s_ainv_solver_descr
end interface end interface

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

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

@ -272,7 +272,7 @@ module amg_s_base_smoother_mod
end interface end interface
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, & import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_smoother_type, psb_ipk_ & 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_base_smoother_descr end subroutine amg_s_base_smoother_descr
end interface end interface

@ -270,7 +270,7 @@ module amg_s_base_solver_mod
end interface end interface
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, & import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_solver_type, psb_ipk_ & 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_base_solver_descr end subroutine amg_s_base_solver_descr
end interface end interface

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

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

@ -433,20 +433,22 @@ contains
return return
end subroutine s_gs_solver_free 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 Implicit None
! Arguments ! Arguments
class(amg_s_gs_solver_type), intent(in) :: sv class(amg_s_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_gs_solver_descr' character(len=20), parameter :: name='amg_s_gs_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -455,12 +457,17 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then 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' & sv%sweeps,' sweeps'
else 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 & sv%eps,' and maxit', sv%sweeps
end if end if
@ -526,20 +533,22 @@ contains
val = .true. val = .true.
end function s_gs_solver_is_iterative 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 Implicit None
! Arguments ! Arguments
class(amg_s_bwgs_solver_type), intent(in) :: sv class(amg_s_bwgs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_bwgs_solver_descr' character(len=20), parameter :: name='amg_s_bwgs_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -548,12 +557,17 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then 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' & sv%sweeps,' sweeps'
else 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 & sv%eps,' and maxit', sv%sweeps
end if end if

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

@ -406,7 +406,7 @@ contains
return return
end subroutine s_ilu_solver_free 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 Implicit None
@ -414,12 +414,14 @@ contains
class(amg_s_ilu_solver_type), intent(in) :: sv class(amg_s_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_ilu_solver_descr' character(len=20), parameter :: name='amg_s_ilu_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -428,15 +430,20 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif 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) & amg_fact_names(sv%fact_type)
select case(sv%fact_type) select case(sv%fact_type)
case(psb_ilu_n_,psb_milu_n_) 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_) case(psb_ilu_t_)
write(iout_,*) ' Fill level:',sv%fill_in write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
write(iout_,*) ' Fill threshold :',sv%thresh write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
end select end select
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

@ -123,7 +123,7 @@ module amg_s_invk_solver
end interface end interface
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_ import :: psb_spk_, amg_s_invk_solver_type, psb_ipk_
Implicit None Implicit None
@ -133,7 +133,7 @@ module amg_s_invk_solver
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_invk_solver_descr end subroutine amg_s_invk_solver_descr
end interface end interface

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

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

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

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

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

@ -258,7 +258,7 @@ module amg_s_onelev_mod
end interface end interface
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, & import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, & & psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_s_base_onelev_descr end subroutine amg_s_base_onelev_descr
end interface end interface

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

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

@ -385,20 +385,22 @@ contains
end subroutine s_slu_solver_finalize 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 Implicit None
! Arguments ! Arguments
class(amg_s_slu_solver_type), intent(in) :: sv class(amg_s_slu_solver_type), intent(in) :: sv
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables ! Local variables
integer :: err_act integer :: err_act
character(len=20), parameter :: name='amg_s_slu_solver_descr' character(len=20), parameter :: name='amg_s_slu_solver_descr'
integer :: iout_ integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -407,8 +409,13 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif 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) call psb_erractionrestore(err_act)
return return

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

@ -198,7 +198,7 @@ module amg_z_ainv_solver
!!$ end interface !!$ end interface
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_ import :: psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
Implicit None Implicit None
@ -208,7 +208,7 @@ module amg_z_ainv_solver
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_ainv_solver_descr end subroutine amg_z_ainv_solver_descr
end interface end interface

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

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

@ -272,7 +272,7 @@ module amg_z_base_smoother_mod
end interface end interface
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, & import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& amg_z_base_smoother_type, psb_ipk_ & 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_base_smoother_descr end subroutine amg_z_base_smoother_descr
end interface end interface

@ -270,7 +270,7 @@ module amg_z_base_solver_mod
end interface end interface
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, & import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& amg_z_base_solver_type, psb_ipk_ & 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_base_solver_descr end subroutine amg_z_base_solver_descr
end interface end interface

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

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

@ -433,20 +433,22 @@ contains
return return
end subroutine z_gs_solver_free 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 Implicit None
! Arguments ! Arguments
class(amg_z_gs_solver_type), intent(in) :: sv class(amg_z_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_z_gs_solver_descr' character(len=20), parameter :: name='amg_z_gs_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -455,12 +457,17 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then 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' & sv%sweeps,' sweeps'
else 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 & sv%eps,' and maxit', sv%sweeps
end if end if
@ -526,20 +533,22 @@ contains
val = .true. val = .true.
end function z_gs_solver_is_iterative 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 Implicit None
! Arguments ! Arguments
class(amg_z_bwgs_solver_type), intent(in) :: sv class(amg_z_bwgs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_z_bwgs_solver_descr' character(len=20), parameter :: name='amg_z_bwgs_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -548,12 +557,17 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then 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' & sv%sweeps,' sweeps'
else 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 & sv%eps,' and maxit', sv%sweeps
end if end if

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

@ -406,7 +406,7 @@ contains
return return
end subroutine z_ilu_solver_free 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 Implicit None
@ -414,12 +414,14 @@ contains
class(amg_z_ilu_solver_type), intent(in) :: sv class(amg_z_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_z_ilu_solver_descr' character(len=20), parameter :: name='amg_z_ilu_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -428,15 +430,20 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif 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) & amg_fact_names(sv%fact_type)
select case(sv%fact_type) select case(sv%fact_type)
case(psb_ilu_n_,psb_milu_n_) 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_) case(psb_ilu_t_)
write(iout_,*) ' Fill level:',sv%fill_in write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
write(iout_,*) ' Fill threshold :',sv%thresh write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
end select end select
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

@ -123,7 +123,7 @@ module amg_z_invk_solver
end interface end interface
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_ import :: psb_dpk_, amg_z_invk_solver_type, psb_ipk_
Implicit None Implicit None
@ -133,7 +133,7 @@ module amg_z_invk_solver
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_invk_solver_descr end subroutine amg_z_invk_solver_descr
end interface end interface

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

@ -219,12 +219,13 @@ module amg_z_jac_smoother
end interface end interface
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_ import :: amg_z_jac_smoother_type, psb_ipk_
class(amg_z_jac_smoother_type), intent(in) :: sm class(amg_z_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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 subroutine amg_z_jac_smoother_descr
end interface end interface
@ -313,12 +314,13 @@ module amg_z_jac_smoother
end interface end interface
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_ import :: amg_z_l1_jac_smoother_type, psb_ipk_
class(amg_z_l1_jac_smoother_type), intent(in) :: sm class(amg_z_l1_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout 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_l1_jac_smoother_descr end subroutine amg_z_l1_jac_smoother_descr
end interface end interface

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

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

@ -257,7 +257,7 @@ module amg_z_onelev_mod
end interface end interface
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, & import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, & & psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_z_base_onelev_descr end subroutine amg_z_base_onelev_descr
end interface end interface

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

@ -385,20 +385,22 @@ contains
end subroutine z_slu_solver_finalize 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 Implicit None
! Arguments ! Arguments
class(amg_z_slu_solver_type), intent(in) :: sv class(amg_z_slu_solver_type), intent(in) :: sv
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables ! Local variables
integer :: err_act integer :: err_act
character(len=20), parameter :: name='amg_z_slu_solver_descr' character(len=20), parameter :: name='amg_z_slu_solver_descr'
integer :: iout_ integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -407,8 +409,13 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif 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) call psb_erractionrestore(err_act)
return return

@ -52,7 +52,7 @@ module amg_z_sludist_solver
use iso_c_binding use iso_c_binding
use amg_z_base_solver_mod 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 type, extends(amg_z_base_solver_type) :: amg_z_sludist_solver_type
@ -270,10 +270,12 @@ contains
! Local variables ! Local variables
type(psb_zspmat_type) :: atmp type(psb_zspmat_type) :: atmp
type(psb_z_csr_sparse_mat) :: acsr 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 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 character(len=20) :: name='z_sludist_solver_bld', ch_err
info=psb_success_ info=psb_success_
@ -293,19 +295,36 @@ contains
n_col = desc_a%get_local_cols() n_col = desc_a%get_local_cols()
nglob = desc_a%get_global_rows() 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 psb_rwextd(n_row,atmp,info,b=b)
call atmp%cscnv(info,type='csr',dupl=psb_dupl_add_)
call atmp%mv_to(acsr) call atmp%mv_to(acsr)
nrow_a = acsr%get_nrows() nrow_a = acsr%get_nrows()
nztota = acsr%get_nzeros() nztota = acsr%get_nzeros()
call psb_loc_to_glob(ione,lfrst,desc_a,info)
! Fix the entries to call C-base SuperLU ! Fix the entries to call C-base SuperLU
call psb_loc_to_glob(1,ifrst,desc_a,info) call psb_realloc(nztota,gja,info)
call psb_loc_to_glob(nrow_a,ibcheck,desc_a,info) call psb_loc_to_glob(acsr%ja(1:nztota),gja(1:nztota), desc_a, info, iact='I')
call psb_loc_to_glob(acsr%ja(1:nztota),desc_a,info,iact='I') acsr%ja(1:nztota) = gja(1:nztota)
acsr%ja(:) = acsr%ja(:) - 1 acsr%ja(:) = acsr%ja(:) - 1
acsr%irp(:) = acsr%irp(:) - 1 acsr%irp(:) = acsr%irp(:) - 1
ifrst = ifrst - 1 ifrst = lfrst - 1
info = amg_zsludist_fact(nglob,nrow_a,nztota,ifrst,& info = amg_zsludist_fact(nglob,nrow_a,nztota,ifrst,&
& acsr%val,acsr%irp,acsr%ja,sv%lufactors,& & acsr%val,acsr%irp,acsr%ja,sv%lufactors,&
& npr,npc) & npr,npc)
@ -318,7 +337,6 @@ contains
end if end if
call acsr%free() call acsr%free()
call atmp%free()
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' end' & write(debug_unit,*) me,' ',trim(name),' end'
@ -403,15 +421,16 @@ contains
end subroutine z_sludist_solver_finalize 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 Implicit None
! Arguments ! Arguments
class(amg_z_sludist_solver_type), intent(in) :: sv class(amg_z_sludist_solver_type), intent(in) :: sv
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables ! Local variables
integer :: err_act integer :: err_act
@ -419,6 +438,7 @@ contains
integer :: me, np integer :: me, np
character(len=20), parameter :: name='amg_z_sludist_solver_descr' character(len=20), parameter :: name='amg_z_sludist_solver_descr'
integer :: iout_ integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -427,8 +447,13 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif 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) call psb_erractionrestore(err_act)
return return

@ -88,16 +88,25 @@ contains
val = "Symmetric Decoupled aggregation" val = "Symmetric Decoupled aggregation"
end function amg_z_symdec_aggregator_fmt 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 implicit none
class(amg_z_symdec_aggregator_type), intent(in) :: ag class(amg_z_symdec_aggregator_type), intent(in) :: ag
type(amg_dml_parms), intent(in) :: parms type(amg_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
write(iout,*) 'Decoupled Aggregator locally-symmetrized' character(1024) :: prefix_
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info) 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 return
end subroutine amg_z_symdec_aggregator_descr end subroutine amg_z_symdec_aggregator_descr

@ -390,20 +390,22 @@ contains
end subroutine z_umf_solver_finalize 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 Implicit None
! Arguments ! Arguments
class(amg_z_umf_solver_type), intent(in) :: sv class(amg_z_umf_solver_type), intent(in) :: sv
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables ! Local variables
integer :: err_act integer :: err_act
character(len=20), parameter :: name='amg_z_umf_solver_descr' character(len=20), parameter :: name='amg_z_umf_solver_descr'
integer :: iout_ integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
@ -412,8 +414,13 @@ contains
else else
iout_ = psb_out_unit iout_ = psb_out_unit
endif 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) call psb_erractionrestore(err_act)
return return

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

@ -70,13 +70,31 @@ amg_d_newmatch_spmm_bld_ov.o
MPCXXOBJS=MatchBoxPC.o \ MPCXXOBJS=MatchBoxPC.o \
algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.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) OBJS = $(FOBJS) $(MPCOBJS) $(MPCXXOBJS)
LIBNAME=libamg_prec.a LIBNAME=libamg_prec.a
lib: $(OBJS) objs: $(OBJS)
lib: objs
$(AR) $(HERE)/$(LIBNAME) $(OBJS) $(AR) $(HERE)/$(LIBNAME) $(OBJS)
$(RANLIB) $(HERE)/$(LIBNAME) $(RANLIB) $(HERE)/$(LIBNAME)

@ -60,17 +60,43 @@ void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
MilanLongInt* ph1_card, MilanLongInt* ph2_card ) { MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
MPI_Comm C_comm=MPI_Comm_f2c(icomm); MPI_Comm C_comm=MPI_Comm_f2c(icomm);
#ifdef DEBUG #ifdef DEBUG
fprintf(stderr,"MatchBoxPC: rank %d nlver %ld nledge %ld [ %ld %ld ]\n", fprintf(stderr,"MatchBoxPC: rank %d nlver %ld nledge %ld [ %ld %ld ]\n",
myRank,NLVer, NLEdge,verDistance[0],verDistance[1]); myRank,NLVer, NLEdge,verDistance[0],verDistance[1]);
#endif #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, verLocPtr, verLocInd, edgeLocWeight,
verDistance, Mate, verDistance, Mate,
myRank, numProcs, C_comm, myRank, numProcs, C_comm,
msgIndSent, msgActualSent, msgPercent, msgIndSent, msgActualSent, msgPercent,
ph0_time, ph1_time, ph2_time, ph0_time, ph1_time, ph2_time,
ph1_card, ph2_card ); 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 #endif
} }

@ -52,145 +52,412 @@
#ifndef _matchboxpC_H_ #ifndef _matchboxpC_H_
#define _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_ //#define PRINT_DEBUG_INFO_
#include <stdio.h> #include <stdio.h>
#include <iostream> #include <iostream>
#include <assert.h> #include <assert.h>
#include <map> #include <map>
#include <vector> #include <vector>
// #include "matchboxp.h" #include "omp.h"
#include "primitiveDataTypeDefinitions.h" #include "primitiveDataTypeDefinitions.h"
#include "dataStrStaticQueue.h" #include "dataStrStaticQueue.h"
using namespace std; 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 #ifdef __cplusplus
extern "C" { extern "C"
{
#endif #endif
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
#define MilanMpiLongInt MPI_LONG_LONG #define MilanMpiLongInt MPI_LONG_LONG
#ifndef _primitiveDataType_Definition_ #ifndef _primitiveDataType_Definition_
#define _primitiveDataType_Definition_ #define _primitiveDataType_Definition_
//Regular integer: // Regular integer:
#ifndef INTEGER_H #ifndef INTEGER_H
#define INTEGER_H #define INTEGER_H
typedef int32_t MilanInt; typedef int32_t MilanInt;
#endif #endif
//Regular long integer: // Regular long integer:
#ifndef LONG_INT_H #ifndef LONG_INT_H
#define LONG_INT_H #define LONG_INT_H
#ifdef BIT64 #ifdef BIT64
typedef int64_t MilanLongInt; typedef int64_t MilanLongInt;
typedef MPI_LONG MilanMpiLongInt; typedef MPI_LONG MilanMpiLongInt;
#else #else
typedef int32_t MilanLongInt; typedef int32_t MilanLongInt;
typedef MPI_INT MilanMpiLongInt; typedef MPI_INT MilanMpiLongInt;
#endif #endif
#endif #endif
//Regular boolean // Regular boolean
#ifndef BOOL_H #ifndef BOOL_H
#define BOOL_H #define BOOL_H
typedef bool MilanBool; typedef bool MilanBool;
#endif #endif
//Regular double and absolute value computation: // Regular double and absolute value computation:
#ifndef REAL_H #ifndef REAL_H
#define REAL_H #define REAL_H
typedef double MilanReal; typedef double MilanReal;
typedef MPI_DOUBLE MilanMpiReal; typedef MPI_DOUBLE MilanMpiReal;
inline MilanReal MilanAbs(MilanReal value) inline MilanReal MilanAbs(MilanReal value)
{ {
return fabs(value); return fabs(value);
} }
#endif #endif
//Regular float and absolute value computation: // Regular float and absolute value computation:
#ifndef FLOAT_H #ifndef FLOAT_H
#define FLOAT_H #define FLOAT_H
typedef float MilanFloat; typedef float MilanFloat;
typedef MPI_FLOAT MilanMpiFloat; typedef MPI_FLOAT MilanMpiFloat;
inline MilanFloat MilanAbsFloat(MilanFloat value) inline MilanFloat MilanAbsFloat(MilanFloat value)
{ {
return fabs(value); return fabs(value);
} }
#endif #endif
//// Define the limits: //// Define the limits:
#ifndef LIMITS_H #ifndef LIMITS_H
#define LIMITS_H #define LIMITS_H
//Integer Maximum and Minimum: // Integer Maximum and Minimum:
// #define MilanIntMax INT_MAX // #define MilanIntMax INT_MAX
// #define MilanIntMin INT_MIN // #define MilanIntMin INT_MIN
#define MilanIntMax INT32_MAX #define MilanIntMax INT32_MAX
#define MilanIntMin INT32_MIN #define MilanIntMin INT32_MIN
#ifdef BIT64 #ifdef BIT64
#define MilanLongIntMax INT64_MAX #define MilanLongIntMax INT64_MAX
#define MilanLongIntMin -INT64_MAX #define MilanLongIntMin -INT64_MAX
#else #else
#define MilanLongIntMax INT32_MAX #define MilanLongIntMax INT32_MAX
#define MilanLongIntMin -INT32_MAX #define MilanLongIntMin -INT32_MAX
#endif #endif
#endif #endif
// +INFINITY // +INFINITY
const double PLUS_INFINITY = numeric_limits<int>::infinity(); const double PLUS_INFINITY = numeric_limits<int>::infinity();
const double MINUS_INFINITY = -PLUS_INFINITY; const double MINUS_INFINITY = -PLUS_INFINITY;
//#define MilanRealMax LDBL_MAX //#define MilanRealMax LDBL_MAX
#define MilanRealMax PLUS_INFINITY #define MilanRealMax PLUS_INFINITY
#define MilanRealMin MINUS_INFINITY #define MilanRealMin MINUS_INFINITY
#endif #endif
//Function of find the owner of a ghost vertex using binary search: // Function of find the owner of a ghost vertex using binary search:
inline MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance, MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
MilanInt myRank, MilanInt numProcs); MilanInt myRank, MilanInt numProcs);
void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC MilanLongInt firstComputeCandidateMate(MilanLongInt adj1,
( MilanLongInt adj2,
MilanLongInt NLVer, MilanLongInt NLEdge, MilanLongInt *verLocInd,
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight, MilanReal *edgeLocWeight);
MilanLongInt* verDistance,
MilanLongInt* Mate, void queuesTransfer(vector<MilanLongInt> &U,
MilanInt myRank, MilanInt numProcs, MPI_Comm comm, vector<MilanLongInt> &privateU,
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent, vector<MilanLongInt> &QLocalVtx,
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time, vector<MilanLongInt> &QGhostVtx,
MilanLongInt* ph1_card, MilanLongInt* ph2_card ); vector<MilanLongInt> &QMsgType,
vector<MilanInt> &QOwner,
void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC vector<MilanLongInt> &privateQLocalVtx,
( vector<MilanLongInt> &privateQGhostVtx,
MilanLongInt NLVer, MilanLongInt NLEdge, vector<MilanLongInt> &privateQMsgType,
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight, vector<MilanInt> &privateQOwner);
MilanLongInt* verDistance,
MilanLongInt* Mate, bool isAlreadyMatched(MilanLongInt node,
MilanInt myRank, MilanInt numProcs, MPI_Comm comm, MilanLongInt StartIndex,
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent, MilanLongInt EndIndex,
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time, vector<MilanLongInt> &GMate,
MilanLongInt* ph1_card, MilanLongInt* ph2_card ); MilanLongInt *Mate,
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight, MilanLongInt computeCandidateMate(MilanLongInt adj1,
MilanLongInt* verDistance, MilanLongInt adj2,
MilanLongInt* Mate, MilanReal *edgeLocWeight,
MilanInt myRank, MilanInt numProcs, MilanInt icomm, MilanLongInt k,
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent, MilanLongInt *verLocInd,
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time, MilanLongInt StartIndex,
MilanLongInt* ph1_card, MilanLongInt* ph2_card ); MilanLongInt EndIndex,
vector<MilanLongInt> &GMate,
void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge, MilanLongInt *Mate,
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight, map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
MilanLongInt* verDistance,
MilanLongInt* Mate, void initialize(MilanLongInt NLVer, MilanLongInt NLEdge,
MilanInt myRank, MilanInt numProcs, MilanInt icomm, MilanLongInt StartIndex, MilanLongInt EndIndex,
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent, MilanLongInt *numGhostEdgesPtr,
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time, MilanLongInt *numGhostVerticesPtr,
MilanLongInt* ph1_card, MilanLongInt* ph2_card ); 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 #endif
#ifdef __cplusplus #ifdef __cplusplus

@ -72,12 +72,6 @@
#ifdef SERIAL_MPI #ifdef SERIAL_MPI
#else #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 // DOUBLE PRECISION VERSION
//WARNING: The vertex block on a given rank is contiguous //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_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros 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' name='amg_c_dec_aggregator_tprol'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -108,6 +110,10 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
info = psb_success_ info = psb_success_
ctxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ctxt,me,np) 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',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_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 ! The decoupled aggregator based on SOC measures ignores
! ag_data except for clean_zeros; soc_map_bld is a procedure pointer. ! 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 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) 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 (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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol') 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 real(psb_spk_) :: anorm, omega, tmp, dg, theta
logical, parameter :: debug_new=.false. logical, parameter :: debug_new=.false.
character(len=80) :: filename 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' name='amg_aggrmat_smth_bld'
info=psb_success_ info=psb_success_
@ -153,6 +156,23 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
ctxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ctxt, me, np) 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() nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_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 ! naggr: number of local aggregates
! nrow: local rows. ! nrow: local rows.
! !
if (do_timings) call psb_tic(idx_phase1)
! Get the diagonal D ! Get the diagonal D
adiag = a%get_diag(info) 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 ! Build the filtered matrix Af from A
! !
!$OMP parallel do private(i,j,tmp,jd) schedule(static)
do i=1, nrow do i=1, nrow
tmp = czero tmp = czero
jd = -1 jd = -1
@ -214,11 +235,13 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
acsrf%val(jd)=acsrf%val(jd)-tmp acsrf%val(jd)=acsrf%val(jd)-tmp
end if end if
enddo enddo
!$OMP end parallel do
! Take out zeroed terms ! Take out zeroed terms
call acsrf%clean_zeros(info) call acsrf%clean_zeros(info)
end if end if
!$OMP parallel do private(i) schedule(static)
do i=1,size(adiag) do i=1,size(adiag)
if (adiag(i) /= czero) then if (adiag(i) /= czero) then
adiag(i) = cone / adiag(i) adiag(i) = cone / adiag(i)
@ -226,7 +249,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
adiag(i) = cone adiag(i) = cone
end if end if
end do end do
!$OMP end parallel do
if (parms%aggr_omega_alg == amg_eig_est_) then if (parms%aggr_omega_alg == amg_eig_est_) then
if (parms%aggr_eig == amg_max_norm_) 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_') call psb_errpush(info,name,a_err='invalid amg_aggr_omega_alg_')
goto 9999 goto 9999
end if end if
if (do_timings) call psb_toc(idx_phase1)
if (do_timings) call psb_tic(idx_phase2)
call acsrf%scal(adiag,info) call acsrf%scal(adiag,info)
if (info /= psb_success_) goto 9999 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_cdasb(desc_ac,info)
call psb_cd_reinit(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 ! Build the smoothed prolongator using either A or Af
! acsr1 = (I-w*D*A) Prol acsr1 = (I-w*D*Af) Prol ! 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') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
goto 9999 goto 9999
end if end if
if (do_timings) call psb_toc(idx_phase3)
if (do_timings) call psb_tic(idx_ptap)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done SPSPMM 1' & '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_prol%mv_from(coo_prol)
call op_restr%mv_from(coo_restr) call op_restr%mv_from(coo_restr)
if (do_timings) call psb_toc(idx_ptap)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done smooth_aggregate ' & 'Done smooth_aggregate '

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

Loading…
Cancel
Save