fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-07 07:04:59 +00:00
Code Issues Packages Projects Releases Wiki Activity

Compare commits

merge into: fdurastante/amg4psblas:repack-newsolve
Branches Tags
fdurastante/amg4psblas:development fdurastante/amg4psblas:mumps-devel fdurastante/amg4psblas:ExperimentMixed fdurastante/amg4psblas:communication_v2 fdurastante/amg4psblas:remap-coarse fdurastante/amg4psblas:merge-kinsol-maint fdurastante/amg4psblas:maint-1.2.0 fdurastante/amg4psblas:testmergemaint fdurastante/amg4psblas:kinsol-stop fdurastante/amg4psblas:merge-maint-par fdurastante/amg4psblas:gpucinterfaces fdurastante/amg4psblas:matrix-free fdurastante/amg4psblas:cmake fdurastante/amg4psblas:repackage fdurastante/amg4psblas:repack-newsolve fdurastante/amg4psblas:l1-and-0-aggr fdurastante/amg4psblas:l1aggregation fdurastante/amg4psblas:PolySmooth fdurastante/amg4psblas:Poly-novrl fdurastante/amg4psblas:maint-1.1 fdurastante/amg4psblas:jac_solver fdurastante/amg4psblas:master fdurastante/amg4psblas:dev-openmp fdurastante/amg4psblas:TestFerdous fdurastante/amg4psblas:omp-walther fdurastante/amg4psblas:openmp-match fdurastante/amg4psblas:maint-1.1.0 fdurastante/amg4psblas:fixmatch fdurastante/amg4psblas:tspmm fdurastante/amg4psblas:maint-1.0 fdurastante/amg4psblas:maint-1.0.1 fdurastante/amg4psblas:fix-sludist7 fdurastante/amg4psblas:savebcmatch fdurastante/amg4psblas:configry fdurastante/amg4psblas:mergeparmatch fdurastante/amg4psblas:documentation fdurastante/amg4psblas:new-context fdurastante/amg4psblas:implement-ainv fdurastante/amg4psblas:merge-amgext fdurastante/amg4psblas:unify_aggr_bld fdurastante/amg4psblas:unify_aggr_bld_richardson fdurastante/amg4psblas:pizdaint-runs fdurastante/amg4psblas:richardson fdurastante/amg4psblas:stopcriterion
fdurastante/amg4psblas:v1.2.0-1 fdurastante/amg4psblas:v1.2.0 fdurastante/amg4psblas:v1.2.0-rc3 fdurastante/amg4psblas:v1.2.0-rc2 fdurastante/amg4psblas:v1.2.0-rc1 fdurastante/amg4psblas:v1.1.2 fdurastante/amg4psblas:v1.1.1 fdurastante/amg4psblas:v1.1.0 fdurastante/amg4psblas:v1.0.1 fdurastante/amg4psblas:V1.0.0 fdurastante/amg4psblas:v1.0-rc2
..
pull from: fdurastante/amg4psblas:maint-1.0.1
Branches Tags
fdurastante/amg4psblas:mumps-devel fdurastante/amg4psblas:development fdurastante/amg4psblas:ExperimentMixed fdurastante/amg4psblas:communication_v2 fdurastante/amg4psblas:remap-coarse fdurastante/amg4psblas:merge-kinsol-maint fdurastante/amg4psblas:maint-1.2.0 fdurastante/amg4psblas:testmergemaint fdurastante/amg4psblas:kinsol-stop fdurastante/amg4psblas:merge-maint-par fdurastante/amg4psblas:gpucinterfaces fdurastante/amg4psblas:matrix-free fdurastante/amg4psblas:cmake fdurastante/amg4psblas:repackage fdurastante/amg4psblas:repack-newsolve fdurastante/amg4psblas:l1-and-0-aggr fdurastante/amg4psblas:l1aggregation fdurastante/amg4psblas:PolySmooth fdurastante/amg4psblas:Poly-novrl fdurastante/amg4psblas:maint-1.1 fdurastante/amg4psblas:jac_solver fdurastante/amg4psblas:master fdurastante/amg4psblas:dev-openmp fdurastante/amg4psblas:TestFerdous fdurastante/amg4psblas:omp-walther fdurastante/amg4psblas:openmp-match fdurastante/amg4psblas:maint-1.1.0 fdurastante/amg4psblas:fixmatch fdurastante/amg4psblas:tspmm fdurastante/amg4psblas:maint-1.0 fdurastante/amg4psblas:maint-1.0.1 fdurastante/amg4psblas:fix-sludist7 fdurastante/amg4psblas:savebcmatch fdurastante/amg4psblas:configry fdurastante/amg4psblas:mergeparmatch fdurastante/amg4psblas:documentation fdurastante/amg4psblas:new-context fdurastante/amg4psblas:implement-ainv fdurastante/amg4psblas:merge-amgext fdurastante/amg4psblas:unify_aggr_bld fdurastante/amg4psblas:unify_aggr_bld_richardson fdurastante/amg4psblas:pizdaint-runs fdurastante/amg4psblas:richardson fdurastante/amg4psblas:stopcriterion
fdurastante/amg4psblas:v1.2.0-1 fdurastante/amg4psblas:v1.2.0 fdurastante/amg4psblas:v1.2.0-rc3 fdurastante/amg4psblas:v1.2.0-rc2 fdurastante/amg4psblas:v1.2.0-rc1 fdurastante/amg4psblas:v1.1.2 fdurastante/amg4psblas:v1.1.1 fdurastante/amg4psblas:v1.1.0 fdurastante/amg4psblas:v1.0.1 fdurastante/amg4psblas:V1.0.0 fdurastante/amg4psblas:v1.0-rc2
3 Commits
repack-newsolve .. maint-1.0.1
Author SHA1 Message Date
Salvatore Filippone bbed340405 Merge branch 'master' into maint-1.0 2022-04-16 17:30:00 +02:00
Salvatore Filippone 51a9d16975 Fixed samples 2021-07-15 12:28:38 +02:00
Salvatore Filippone a04f7b4cf0 Simple shell to download sample matrices 2021-07-15 12:16:56 +02:00
391 changed files with 5906 additions and 29779 deletions
Expand all files Collapse all files
.gitignore
+3 -3
View File
@@ -12,9 +12,9 @@ config.log
config.status
# generated folder
/include/
/modules/
/docs/src/tmp
include/
modules/
docs/src/tmp
autom4te.cache
# the executable from tests
Changelog
-1
View File
@@ -1,6 +1,5 @@
Changelog. A lot less detailed than usual, at least for past
history.
2022/05/20: Restart ChangeLog. Updated to new name AMG4PSBLAS, now using PSB3.8
2018/10/28: Fix interface to MUMPS and configry machinery. Require PSB 3.6.
2018/10/10: ICTXT argument in prec%init().
2018/07/30: Fixes for Intel compilers. BootCMatch interface in examples.
LICENSE
+3 -3
View File
@@ -1,10 +1,10 @@
AMG4PSBLAS version 1.1
AMG4PSBLAS version 1.0
Algebraic Multigrid Package
based on PSBLAS (Parallel Sparse BLAS version 3.8)
based on PSBLAS (Parallel Sparse BLAS version 3.7)
(C) Copyright 2022
(C) Copyright 2021
Salvatore Filippone
Pasqua D'Ambra
Make.inc.in
+1 -1
View File
@@ -75,7 +75,7 @@ CDEFINES=$(AMGCDEFINES)
AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
FDEFINES=$(AMGFDEFINES)
CXXDEFINES=@AMGCXXDEFINES@ $(PSBCXXDEFINES)
CXXDEFINES=@AMGCXXDEFINES@
@COMPILERULES@
Make_n.inc.in
+1 -1
View File
@@ -49,7 +49,7 @@ PSBLAS_INCLUDES=@PSBLAS_INCLUDES@
PSBLAS_LIBS=@PSBLAS_LIBS@
PSBBASEMODNAME=psb_base_mod
PSBPRECMODNAME=psb_prec_mod
PSBMETHDMODNAME=psb_linsolve_mod
PSBMETHDMODNAME=psb_krylov_mod
PSBUTILMODNAME=psb_util_mod
Makefile
+12 -18
View File
@@ -1,13 +1,10 @@
include Make.inc
all: objs lib
all: library
objs: libdir amgp cbnd
lib: objs
cd amgprec && $(MAKE) lib
cd cbind && $(MAKE) lib
library: libdir amgp cbnd
#cbnd
libdir:
(if test ! -d lib ; then mkdir lib; fi)
@@ -17,11 +14,10 @@ libdir:
amgp:
cd amgprec && $(MAKE) objs
$(MAKE) -C amgprec all
cbnd: amgp
cd cbind && $(MAKE) objs
install: lib
$(MAKE) -C cbind all
install: all
mkdir -p $(INSTALL_LIBDIR) &&\
$(INSTALL_DATA) lib/*.a $(INSTALL_LIBDIR)
mkdir -p $(INSTALL_INCLUDEDIR) &&\
@@ -45,16 +41,14 @@ cleanlib:
(cd modules; /bin/rm -f *.a *$(.mod) *$(.fh))
veryclean: cleanlib
(cd amgprec && $(MAKE) veryclean)
(cd cbind && $(MAKE) veryclean)
(cd samples/simple/fileread && $(MAKE) clean)
(cd samples/simple/pdegen && $(MAKE) clean)
(cd samples/advanced/fileread && $(MAKE) clean)
(cd samples/advanced/pdegen && $(MAKE) clean)
(cd amgprec; make veryclean)
(cd samples/simple/fileread; make clean)
(cd samples/simple/pdegen; make clean)
(cd samples/advanced/fileread; make clean)
(cd samples/advanced/pdegen; make clean)
check: all
make check -C samples/advanced/pdegen
clean:
(cd amgprec && $(MAKE) clean)
(cd cbind && $(MAKE) clean)
(cd amgprec; make clean)
README.md
+2 -1
View File
@@ -1,5 +1,6 @@
AMG4PSBLAS
Algebraic Multigrid Package based on PSBLAS (Parallel Sparse BLAS version 3.8)
Algebraic Multigrid Package based on PSBLAS (Parallel Sparse BLAS version 3.7)
Salvatore Filippone (University of Rome Tor Vergata and IAC-CNR)
Pasqua D'Ambra (IAC-CNR, Naples, IT)
amgprec/Makefile
+15 -21
View File
@@ -9,10 +9,9 @@ FINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(INCDIR) $(PSBLAS_INCLUDES)
DMODOBJS=amg_d_prec_type.o \
amg_d_inner_mod.o amg_d_ilu_solver.o amg_d_diag_solver.o amg_d_jac_smoother.o amg_d_as_smoother.o \
amg_d_poly_smoother.o amg_d_poly_coeff_mod.o\
amg_d_umf_solver.o amg_d_slu_solver.o amg_d_sludist_solver.o amg_d_id_solver.o\
amg_d_base_solver_mod.o amg_d_base_smoother_mod.o amg_d_onelev_mod.o \
amg_d_gs_solver.o amg_d_mumps_solver.o amg_d_jac_solver.o \
amg_d_gs_solver.o amg_d_mumps_solver.o \
amg_d_base_aggregator_mod.o \
amg_d_dec_aggregator_mod.o amg_d_symdec_aggregator_mod.o \
amg_d_ainv_solver.o amg_d_base_ainv_mod.o \
@@ -21,9 +20,9 @@ DMODOBJS=amg_d_prec_type.o \
SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \
amg_s_inner_mod.o amg_s_ilu_solver.o amg_s_diag_solver.o amg_s_jac_smoother.o amg_s_as_smoother.o \
amg_s_poly_smoother.o amg_s_slu_solver.o amg_s_id_solver.o\
amg_s_slu_solver.o amg_s_id_solver.o\
amg_s_base_solver_mod.o amg_s_base_smoother_mod.o amg_s_onelev_mod.o \
amg_s_gs_solver.o amg_s_mumps_solver.o amg_s_jac_solver.o \
amg_s_gs_solver.o amg_s_mumps_solver.o \
amg_s_base_aggregator_mod.o \
amg_s_dec_aggregator_mod.o amg_s_symdec_aggregator_mod.o \
amg_s_ainv_solver.o amg_s_base_ainv_mod.o \
@@ -34,7 +33,7 @@ ZMODOBJS=amg_z_prec_type.o amg_z_ilu_fact_mod.o \
amg_z_inner_mod.o amg_z_ilu_solver.o amg_z_diag_solver.o amg_z_jac_smoother.o amg_z_as_smoother.o \
amg_z_umf_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o amg_z_id_solver.o\
amg_z_base_solver_mod.o amg_z_base_smoother_mod.o amg_z_onelev_mod.o \
amg_z_gs_solver.o amg_z_mumps_solver.o amg_z_jac_solver.o \
amg_z_gs_solver.o amg_z_mumps_solver.o \
amg_z_base_aggregator_mod.o \
amg_z_dec_aggregator_mod.o amg_z_symdec_aggregator_mod.o \
amg_z_ainv_solver.o amg_z_base_ainv_mod.o \
@@ -44,7 +43,7 @@ CMODOBJS=amg_c_prec_type.o amg_c_ilu_fact_mod.o \
amg_c_inner_mod.o amg_c_ilu_solver.o amg_c_diag_solver.o amg_c_jac_smoother.o amg_c_as_smoother.o \
amg_c_slu_solver.o amg_c_id_solver.o\
amg_c_base_solver_mod.o amg_c_base_smoother_mod.o amg_c_onelev_mod.o \
amg_c_gs_solver.o amg_c_mumps_solver.o amg_c_jac_solver.o \
amg_c_gs_solver.o amg_c_mumps_solver.o \
amg_c_base_aggregator_mod.o \
amg_c_dec_aggregator_mod.o amg_c_symdec_aggregator_mod.o \
amg_c_ainv_solver.o amg_c_base_ainv_mod.o \
@@ -63,20 +62,17 @@ OBJS=$(MODOBJS)
LOCAL_MODS=$(MODOBJS:.o=$(.mod))
LIBNAME=libamg_prec.a
all: objs impld
all: lib impld
objs: $(OBJS)
/bin/cp -p amg_const.h $(INCDIR)
/bin/cp -p *$(.mod) $(MODDIR)
impld: objs
cd impl && $(MAKE)
impld: $(OBJS)
$(MAKE) -C impl
lib: $(OBJS) impld
cd impl && $(MAKE) lib
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
$(RANLIB) $(HERE)/$(LIBNAME)
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
/bin/cp -p amg_const.h $(INCDIR)
/bin/cp -p *$(.mod) $(MODDIR)
$(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
@@ -156,7 +152,7 @@ amg_z_base_ainv_mod.o: amg_z_base_solver_mod.o amg_base_ainv_mod.o
amg_s_base_solver_mod.o amg_d_base_solver_mod.o amg_c_base_solver_mod.o amg_z_base_solver_mod.o: amg_base_prec_type.o
amg_d_mumps_solver.o amg_d_gs_solver.o amg_d_id_solver.o amg_d_sludist_solver.o amg_d_slu_solver.o \
amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o amg_d_jac_solver.o: amg_d_base_solver_mod.o amg_d_prec_type.o
amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o: amg_d_base_solver_mod.o amg_d_prec_type.o
#amg_d_ilu_fact_mod.o: amg_base_prec_type.o amg_d_base_solver_mod.o
#amg_d_ilu_solver.o amg_d_iluk_fact.o: amg_d_ilu_fact_mod.o
@@ -165,11 +161,9 @@ amg_d_jac_smoother.o: amg_d_diag_solver.o
amg_dprecinit.o amg_dprecset.o: amg_d_diag_solver.o amg_d_ilu_solver.o \
amg_d_umf_solver.o amg_d_as_smoother.o amg_d_jac_smoother.o \
amg_d_id_solver.o amg_d_slu_solver.o amg_d_sludist_solver.o
amg_d_poly_smoother.o: amg_d_base_smoother_mod.o amg_d_poly_coeff_mod.o
amg_s_poly_smoother.o: amg_s_base_smoother_mod.o amg_d_poly_coeff_mod.o
amg_s_mumps_solver.o amg_s_gs_solver.o amg_s_id_solver.o amg_s_slu_solver.o \
amg_s_diag_solver.o amg_s_ilu_solver.o amg_s_jac_solver.o: amg_s_base_solver_mod.o amg_s_prec_type.o
amg_s_diag_solver.o amg_s_ilu_solver.o: amg_s_base_solver_mod.o amg_s_prec_type.o
amg_s_ilu_fact_mod.o: amg_base_prec_type.o amg_s_base_solver_mod.o
amg_s_ilu_solver.o amg_s_iluk_fact.o: amg_s_ilu_fact_mod.o
amg_s_as_smoother.o amg_s_jac_smoother.o: amg_s_base_smoother_mod.o
@@ -179,7 +173,7 @@ amg_sprecinit.o amg_sprecset.o: amg_s_diag_solver.o amg_s_ilu_solver.o \
amg_s_id_solver.o amg_s_slu_solver.o
amg_z_mumps_solver.o amg_z_gs_solver.o amg_z_id_solver.o amg_z_sludist_solver.o amg_z_slu_solver.o \
amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o amg_z_jac_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.o
amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.o
amg_z_ilu_fact_mod.o: amg_base_prec_type.o amg_z_base_solver_mod.o
amg_z_ilu_solver.o amg_z_iluk_fact.o: amg_z_ilu_fact_mod.o
amg_z_as_smoother.o amg_z_jac_smoother.o: amg_z_base_smoother_mod.o
@@ -189,7 +183,7 @@ amg_zprecinit.o amg_zprecset.o: amg_z_diag_solver.o amg_z_ilu_solver.o \
amg_z_id_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o
amg_c_mumps_solver.o amg_c_gs_solver.o amg_c_id_solver.o amg_c_sludist_solver.o amg_c_slu_solver.o \
amg_c_diag_solver.o amg_c_ilu_solver.o amg_c_jac_solver.o: amg_c_base_solver_mod.o amg_c_prec_type.o
amg_c_diag_solver.o amg_c_ilu_solver.o: amg_c_base_solver_mod.o amg_c_prec_type.o
amg_c_ilu_fact_mod.o: amg_base_prec_type.o amg_c_base_solver_mod.o
amg_c_ilu_solver.o amg_c_iluk_fact.o: amg_c_ilu_fact_mod.o
amg_c_as_smoother.o amg_c_jac_smoother.o: amg_c_base_smoother_mod.o
@@ -224,4 +218,4 @@ clean: implclean
/bin/rm -f $(OBJS) $(LOCAL_MODS) *$(.mod)
implclean:
cd impl && $(MAKE) clean
$(MAKE) -C impl clean
amgprec/amg_base_prec_type.F90
+72 -178
View File
@@ -64,7 +64,7 @@ module amg_base_prec_type
!
use psb_const_mod
use psb_base_mod, only :&
& psb_desc_type, psb_ctxt_type,&
& psb_desc_type, psb_i_vect_type, psb_i_base_vect_type,&
& psb_ipk_, psb_dpk_, psb_spk_, psb_epk_, &
& psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, &
& psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,&
@@ -81,10 +81,10 @@ module amg_base_prec_type
!
! Version numbers
!
character(len=*), parameter :: amg_version_string_ = "1.1.0"
character(len=*), parameter :: amg_version_string_ = "1.0.1"
integer(psb_ipk_), parameter :: amg_version_major_ = 1
integer(psb_ipk_), parameter :: amg_version_minor_ = 1
integer(psb_ipk_), parameter :: amg_patchlevel_ = 0
integer(psb_ipk_), parameter :: amg_version_minor_ = 0
integer(psb_ipk_), parameter :: amg_patchlevel_ = 1
type amg_ml_parms
integer(psb_ipk_) :: sweeps_pre, sweeps_post
@@ -94,7 +94,6 @@ module amg_base_prec_type
integer(psb_ipk_) :: aggr_omega_alg, aggr_eig, aggr_filter
integer(psb_ipk_) :: coarse_mat, coarse_solve
contains
procedure, pass(pm) :: get_coarse_mat => ml_parms_get_coarse_mat
procedure, pass(pm) :: get_coarse => ml_parms_get_coarse
procedure, pass(pm) :: clone => ml_parms_clone
procedure, pass(pm) :: descr => ml_parms_descr
@@ -215,8 +214,7 @@ module amg_base_prec_type
integer(psb_ipk_), parameter :: amg_fbgs_ = 6
integer(psb_ipk_), parameter :: amg_l1_gs_ = 7
integer(psb_ipk_), parameter :: amg_l1_fbgs_ = 8
integer(psb_ipk_), parameter :: amg_poly_ = 9
integer(psb_ipk_), parameter :: amg_max_prec_ = 9
integer(psb_ipk_), parameter :: amg_max_prec_ = 8
!
! Constants for pre/post signaling. Now only used internally
!
@@ -234,9 +232,9 @@ module amg_base_prec_type
integer(psb_ipk_), parameter :: amg_diag_scale_ = amg_slv_delta_+1
integer(psb_ipk_), parameter :: amg_l1_diag_scale_ = amg_slv_delta_+2
integer(psb_ipk_), parameter :: amg_gs_ = amg_slv_delta_+3
integer(psb_ipk_), parameter :: amg_ilu_n_ = amg_slv_delta_+4
integer(psb_ipk_), parameter :: amg_milu_n_ = amg_slv_delta_+5
integer(psb_ipk_), parameter :: amg_ilu_t_ = amg_slv_delta_+6
! !$ integer(psb_ipk_), parameter :: amg_ilu_n_ = amg_slv_delta_+4
! !$ integer(psb_ipk_), parameter :: amg_milu_n_ = amg_slv_delta_+5
! !$ integer(psb_ipk_), parameter :: amg_ilu_t_ = amg_slv_delta_+6
integer(psb_ipk_), parameter :: amg_slu_ = amg_slv_delta_+7
integer(psb_ipk_), parameter :: amg_umf_ = amg_slv_delta_+8
integer(psb_ipk_), parameter :: amg_sludist_ = amg_slv_delta_+9
@@ -320,16 +318,6 @@ module amg_base_prec_type
integer(psb_ipk_), parameter :: amg_distr_mat_ = 0
integer(psb_ipk_), parameter :: amg_repl_mat_ = 1
integer(psb_ipk_), parameter :: amg_max_coarse_mat_ = amg_repl_mat_
!
! Legal values for entry: amg_poly_variant_
!
integer(psb_ipk_), parameter :: amg_cheb_4_ = 0
integer(psb_ipk_), parameter :: amg_cheb_4_opt_ = 1
integer(psb_ipk_), parameter :: amg_cheb_1_opt_ = 2
integer(psb_ipk_), parameter :: amg_poly_dbg_ = 8
integer(psb_ipk_), parameter :: amg_poly_rho_est_power_ = 0
!
! Legal values for entry: amg_prec_status_
!
@@ -401,12 +389,12 @@ module amg_base_prec_type
& ml_names(0:7)=(/'none ','additive ',&
& 'multiplicative', 'VCycle ','WCycle ',&
& 'KCycle ','KCycleSym ','new ML '/)
character(len=16), parameter :: &
character(len=15), parameter :: &
& amg_fact_names(0:amg_max_sub_solve_)=(/&
& 'none ','Jacobi ',&
& 'L1-Jacobi ','none ','none ',&
& 'none ','none ','L1-GS ',&
& 'L1-FBGS ','Polynomial ','none ','Point Jacobi ',&
& 'L1-FBGS ','none ','Point Jacobi ',&
& 'L1-Jacobi ','Gauss-Seidel ','ILU(n) ',&
& 'MILU(n) ','ILU(t,n) ',&
& 'SuperLU ','UMFPACK LU ',&
@@ -468,12 +456,12 @@ contains
character(len=*), parameter :: name='amg_stringval'
! Local variable
integer :: index_tab
character(len=128) ::string2
character(len=15) ::string2
index_tab=index(string,char(9))
if (index_tab.NE.0) then
string2=string(1:index_tab-1)
string2=string(1:index_tab-1)
else
string2=string
string2=string
endif
select case(psb_toupper(trim(string2)))
case('NONE')
@@ -493,11 +481,11 @@ contains
case('BGS','BWGS')
val = amg_bwgs_
case('ILU')
val = amg_ilu_n_
val = psb_ilu_n_
case('MILU')
val = amg_milu_n_
val = psb_milu_n_
case('ILUT')
val = amg_ilu_t_
val = psb_ilu_t_
case('MUMPS')
val = amg_mumps_
case('UMF')
@@ -568,18 +556,6 @@ contains
val = amg_krm_
case('AS')
val = amg_as_
case('POLY')
val = amg_poly_
case('CHEB_4')
val = amg_cheb_4_
case('CHEB_4_OPT')
val = amg_cheb_4_opt_
case('CHEB_1_OPT')
val = amg_cheb_1_opt_
case('POLY_DBG')
val = amg_poly_dbg_
case('POLY_RHO_EST_POWER')
val = amg_poly_rho_est_power_
case('A_NORMI')
val = amg_max_norm_
case('USER_CHOICE')
@@ -601,33 +577,6 @@ contains
end select
end function amg_stringval
function amg_get_coarse_mat_name(val) result(res)
character(len=15) :: res
integer :: val
select case(val)
case (0,1)
res = matrix_names(val)
case default
res = 'Unknown '
end select
end function amg_get_coarse_mat_name
subroutine amg_warn_coarse_mat(val,expected)
integer(psb_ipk_) :: val, expected
if (val /= expected) then
write(0,*) 'Warning: resetting COARSE_MAT on an existing hierarchy from ',&
& amg_get_coarse_mat_name(val), ' to ',amg_get_coarse_mat_name(expected)
end if
end subroutine amg_warn_coarse_mat
function ml_parms_get_coarse_mat(pm) result(res)
implicit none
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_) :: res
res = pm%coarse_mat
end function ml_parms_get_coarse_mat
subroutine ml_parms_get_coarse(pm,pmin)
implicit none
class(amg_ml_parms), intent(inout) :: pm
@@ -690,62 +639,53 @@ contains
& ml_names(pm%ml_cycle)
select case (pm%ml_cycle)
case (amg_add_ml_)
write(iout,*) ' Number of smoother sweeps/degree : ',&
write(iout,*) ' Number of smoother sweeps : ',&
& pm%sweeps_pre
case (amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_, amg_kcycle_ml_, amg_kcyclesym_ml_)
write(iout,*) ' Number of smoother sweeps/degree : pre: ',&
write(iout,*) ' Number of smoother sweeps : pre: ',&
& pm%sweeps_pre ,' post: ', pm%sweeps_post
end select
end if
end subroutine ml_parms_mlcycledsc
subroutine ml_parms_mldescr(pm,iout,info,prefix)
subroutine ml_parms_mldescr(pm,iout,info)
Implicit None
! Arguments
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then
write(iout,*) trim(prefix),' Parallel aggregation algorithm: ',&
write(iout,*) ' Parallel aggregation algorithm: ',&
& par_aggr_alg_names(pm%par_aggr_alg)
if (pm%aggr_type>0) write(iout,*) trim(prefix),' Aggregation type: ',&
if (pm%aggr_type>0) write(iout,*) ' Aggregation type: ',&
& aggr_type_names(pm%aggr_type)
!if (pm%par_aggr_alg /= amg_ext_aggr_) then
if ( pm%aggr_ord /= amg_aggr_ord_nat_) &
& write(iout,*) trim(prefix),' with initial ordering: ',&
& write(iout,*) ' with initial ordering: ',&
& ord_names(pm%aggr_ord)
write(iout,*) trim(prefix),' Aggregation prolongator: ', &
write(iout,*) ' Aggregation prolongator: ', &
& aggr_prols(pm%aggr_prol)
if (pm%aggr_prol /= amg_no_smooth_) then
write(iout,*) trim(prefix),' with: ', aggr_filters(pm%aggr_filter)
write(iout,*) ' with: ', aggr_filters(pm%aggr_filter)
if (pm%aggr_omega_alg == amg_eig_est_) then
write(iout,*) trim(prefix),' Damping omega computation: spectral radius estimate'
write(iout,*) trim(prefix),' Spectral radius estimate: ', &
write(iout,*) ' Damping omega computation: spectral radius estimate'
write(iout,*) ' Spectral radius estimate: ', &
& eigen_estimates(pm%aggr_eig)
else if (pm%aggr_omega_alg == amg_user_choice_) then
write(iout,*) trim(prefix),' Damping omega computation: user defined value.'
write(iout,*) ' Damping omega computation: user defined value.'
else
write(iout,*) trim(prefix),' Damping omega computation: unknown value in iprcparm!!'
write(iout,*) ' Damping omega computation: unknown value in iprcparm!!'
end if
end if
!end if
else
write(iout,*) trim(prefix),' Multilevel type: Unkonwn value. Something is amiss....',&
write(iout,*) ' Multilevel type: Unkonwn value. Something is amiss....',&
& pm%ml_cycle
end if
@@ -753,16 +693,15 @@ contains
end subroutine ml_parms_mldescr
subroutine ml_parms_descr(pm,iout,info,coarse,prefix)
subroutine ml_parms_descr(pm,iout,info,coarse)
Implicit None
! Arguments
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
logical :: coarse_
info = psb_success_
@@ -773,7 +712,7 @@ contains
end if
if (coarse_) then
call pm%coarsedescr(iout,info,prefix=prefix)
call pm%coarsedescr(iout,info)
end if
return
@@ -781,126 +720,81 @@ contains
end subroutine ml_parms_descr
subroutine ml_parms_coarsedescr(pm,iout,info,prefix)
subroutine ml_parms_coarsedescr(pm,iout,info)
Implicit None
! Arguments
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix),' Coarse matrix: ',&
write(iout,*) ' Coarse matrix: ',&
& matrix_names(pm%coarse_mat)
select case(pm%coarse_solve)
case (amg_bjac_,amg_as_)
write(iout,*) trim(prefix),' Coarse solver: ',&
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_pre
write(iout,*) ' Coarse solver: ',&
& 'Block Jacobi'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_l1_bjac_)
write(iout,*) trim(prefix),' Coarse solver: ',&
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_pre
write(iout,*) ' Coarse solver: ',&
& 'L1-Block Jacobi'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_jac_)
write(iout,*) trim(prefix),' Coarse solver: ',&
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_pre
write(iout,*) ' Coarse solver: ',&
& 'Point Jacobi'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_l1_jac_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'L1-Jacobi'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_l1_fbgs_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'L1 Forward-Backward Gauss-Seidel (Hybrid)'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_l1_gs_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'L1 Gauss-Seidel (Hybrid)'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_fbgs_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'Forward-Backward Gauss-Seidel (Hybrid)'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case default
write(iout,*) trim(prefix),' Coarse solver: ',&
write(iout,*) ' Coarse solver: ',&
& amg_fact_names(pm%coarse_solve)
end select
end subroutine ml_parms_coarsedescr
subroutine s_ml_parms_descr(pm,iout,info,coarse,prefix)
subroutine s_ml_parms_descr(pm,iout,info,coarse)
Implicit None
! Arguments
class(amg_sml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
class(amg_sml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
info = psb_success_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix)
call pm%amg_ml_parms%descr(iout,info,coarse)
if (pm%aggr_prol /= amg_no_smooth_) then
write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val
write(iout,*) ' Damping omega value :',pm%aggr_omega_val
end if
write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh
return
end subroutine s_ml_parms_descr
subroutine d_ml_parms_descr(pm,iout,info,coarse,prefix)
subroutine d_ml_parms_descr(pm,iout,info,coarse)
Implicit None
! Arguments
class(amg_dml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
class(amg_dml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
info = psb_success_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix)
call pm%amg_ml_parms%descr(iout,info,coarse)
if (pm%aggr_prol /= amg_no_smooth_) then
write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val
write(iout,*) ' Damping omega value :',pm%aggr_omega_val
end if
write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh
return
@@ -1059,8 +953,8 @@ contains
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ilu_fact
is_legal_ilu_fact = ((ip==amg_ilu_n_).or.&
& (ip==amg_milu_n_).or.(ip==amg_ilu_t_))
is_legal_ilu_fact = ((ip==psb_ilu_n_).or.&
& (ip==psb_milu_n_).or.(ip==psb_ilu_t_))
return
end function is_legal_ilu_fact
function is_legal_d_omega(ip)
amgprec/amg_c_ainv_solver.F90
+2 -13
View File
@@ -58,7 +58,6 @@ module amg_c_ainv_solver
procedure, pass(sv) :: check => amg_c_ainv_solver_check
procedure, pass(sv) :: build => amg_c_ainv_solver_bld
procedure, pass(sv) :: clone => amg_c_ainv_solver_clone
procedure, pass(sv) :: clone_settings => amg_c_ainv_solver_clone_settings
procedure, pass(sv) :: cseti => amg_c_ainv_solver_cseti
procedure, pass(sv) :: csetc => amg_c_ainv_solver_csetc
procedure, pass(sv) :: csetr => amg_c_ainv_solver_csetr
@@ -86,16 +85,6 @@ module amg_c_ainv_solver
end subroutine amg_c_ainv_solver_clone
end interface
interface
subroutine amg_c_ainv_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& amg_c_base_solver_type, psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
Implicit None
class(amg_c_ainv_solver_type), intent(inout) :: sv
class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_ainv_solver_clone_settings
end interface
interface
subroutine amg_c_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
@@ -209,7 +198,7 @@ module amg_c_ainv_solver
!!$ end interface
interface
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
Implicit None
@@ -219,7 +208,7 @@ module amg_c_ainv_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_c_ainv_solver_descr
end interface
amgprec/amg_c_as_smoother.f90
+9 -16
View File
@@ -396,23 +396,21 @@ contains
end subroutine c_as_smoother_default
subroutine c_as_smoother_descr(sm,info,iout,coarse,prefix)
subroutine c_as_smoother_descr(sm,info,iout,coarse)
Implicit None
! Arguments
class(amg_c_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_as_smoother_descr'
integer(psb_ipk_) :: iout_
logical :: coarse_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -426,21 +424,16 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (.not.coarse_) then
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
write(iout_,*) ' Additive Schwarz with ',&
& sm%novr, ' overlap layers.'
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) trim(prefix_), ' Local solver:'
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) ' Local solver:'
endif
if (allocated(sm%sv)) then
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
call sm%sv%descr(info,iout_,coarse=coarse)
end if
call psb_erractionrestore(err_act)
amgprec/amg_c_base_aggregator_mod.f90
+3 -10
View File
@@ -275,22 +275,15 @@ contains
val = .false.
end function amg_c_base_aggregator_xt_desc
subroutine amg_c_base_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_c_base_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_c_base_aggregator_type), intent(in) :: ag
type(amg_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_c_base_aggregator_descr
amgprec/amg_c_base_smoother_mod.f90
+1 -2
View File
@@ -272,7 +272,7 @@ module amg_c_base_smoother_mod
end interface
interface
subroutine amg_c_base_smoother_descr(sm,info,iout,coarse,prefix)
subroutine amg_c_base_smoother_descr(sm,info,iout,coarse)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_smoother_type, psb_ipk_
@@ -281,7 +281,6 @@ module amg_c_base_smoother_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_c_base_smoother_descr
end interface
amgprec/amg_c_base_solver_mod.f90
+2 -2
View File
@@ -270,7 +270,7 @@ module amg_c_base_solver_mod
end interface
interface
subroutine amg_c_base_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_c_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_solver_type, psb_ipk_
@@ -281,7 +281,7 @@ module amg_c_base_solver_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_c_base_solver_descr
end interface
amgprec/amg_c_dec_aggregator_mod.f90
+4 -11
View File
@@ -184,23 +184,16 @@ contains
val = "Decoupled aggregation"
end function amg_c_dec_aggregator_fmt
subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_c_dec_aggregator_type), intent(in) :: ag
type(amg_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Decoupled Aggregator'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_c_dec_aggregator_descr
amgprec/amg_c_diag_solver.f90
+6 -20
View File
@@ -219,7 +219,7 @@ contains
end subroutine c_diag_solver_free
subroutine c_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine c_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -228,13 +228,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -242,13 +240,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Diagonal local solver '
write(iout_,*) ' Diagonal local solver '
return
@@ -359,7 +352,7 @@ module amg_c_l1_diag_solver
contains
subroutine c_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine c_l1_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -368,13 +361,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_l1_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -382,13 +373,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
write(iout_,*) ' L1 Diagonal solver '
return
amgprec/amg_c_gs_solver.f90
+12 -26
View File
@@ -433,22 +433,20 @@ contains
return
end subroutine c_gs_solver_free
subroutine c_gs_solver_descr(sv,info,iout,coarse,prefix)
subroutine c_gs_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_c_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_gs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -457,17 +455,12 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
@@ -533,22 +526,20 @@ contains
val = .true.
end function c_gs_solver_is_iterative
subroutine c_bwgs_solver_descr(sv,info,iout,coarse,prefix)
subroutine c_bwgs_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_c_bwgs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_bwgs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -557,17 +548,12 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
amgprec/amg_c_id_solver.f90
+3 -10
View File
@@ -157,7 +157,7 @@ contains
return
end subroutine c_id_solver_free
subroutine c_id_solver_descr(sv,info,iout,coarse,prefix)
subroutine c_id_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -165,14 +165,12 @@ contains
class(amg_c_id_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_id_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -180,13 +178,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Identity local solver '
write(iout_,*) ' Identity local solver '
return
amgprec/amg_c_ilu_solver.f90
+14 -21
View File
@@ -234,7 +234,7 @@ contains
! Arguments
class(amg_c_ilu_solver_type), intent(inout) :: sv
sv%fact_type = amg_ilu_n_
sv%fact_type = psb_ilu_n_
sv%fill_in = 0
sv%thresh = szero
@@ -255,13 +255,13 @@ contains
info = psb_success_
call amg_check_def(sv%fact_type,&
& 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
& 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
select case(sv%fact_type)
case(amg_ilu_n_,amg_milu_n_)
case(psb_ilu_n_,psb_milu_n_)
call amg_check_def(sv%fill_in,&
& 'Level',izero,is_int_non_negative)
case(amg_ilu_t_)
case(psb_ilu_t_)
call amg_check_def(sv%thresh,&
& 'Eps',szero,is_legal_s_fact_thrs)
end select
@@ -406,7 +406,7 @@ contains
return
end subroutine c_ilu_solver_free
subroutine c_ilu_solver_descr(sv,info,iout,coarse,prefix)
subroutine c_ilu_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -414,14 +414,12 @@ contains
class(amg_c_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_ilu_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -430,20 +428,15 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
write(iout_,*) ' Incomplete factorization solver: ',&
& amg_fact_names(sv%fact_type)
select case(sv%fact_type)
case(amg_ilu_n_,amg_milu_n_)
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
case(amg_ilu_t_)
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
case(psb_ilu_n_,psb_milu_n_)
write(iout_,*) ' Fill level:',sv%fill_in
case(psb_ilu_t_)
write(iout_,*) ' Fill level:',sv%fill_in
write(iout_,*) ' Fill threshold :',sv%thresh
end select
call psb_erractionrestore(err_act)
@@ -496,7 +489,7 @@ contains
implicit none
integer(psb_ipk_) :: val
val = amg_ilu_n_
val = psb_ilu_n_
end function c_ilu_solver_get_id
function c_ilu_solver_get_wrksize() result(val)
amgprec/amg_c_invk_solver.f90
+2 -14
View File
@@ -52,7 +52,6 @@ module amg_c_invk_solver
contains
procedure, pass(sv) :: check => amg_c_invk_solver_check
procedure, pass(sv) :: clone => amg_c_invk_solver_clone
procedure, pass(sv) :: clone_settings => amg_c_invk_solver_clone_settings
procedure, pass(sv) :: build => amg_c_invk_solver_bld
procedure, pass(sv) :: cseti => amg_c_invk_solver_cseti
procedure, pass(sv) :: descr => amg_c_invk_solver_descr
@@ -74,17 +73,6 @@ module amg_c_invk_solver
end subroutine amg_c_invk_solver_clone
end interface
interface
subroutine amg_c_invk_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& amg_c_base_solver_type, psb_spk_, amg_c_invk_solver_type, psb_ipk_
Implicit None
class(amg_c_invk_solver_type), intent(inout) :: sv
class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_invk_solver_clone_settings
end interface
interface
subroutine amg_c_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
@@ -135,7 +123,7 @@ module amg_c_invk_solver
end interface
interface
subroutine amg_c_invk_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_c_invk_solver_descr(sv,info,iout,coarse)
import :: psb_spk_, amg_c_invk_solver_type, psb_ipk_
Implicit None
@@ -145,7 +133,7 @@ module amg_c_invk_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_c_invk_solver_descr
end interface
amgprec/amg_c_invt_solver.f90
+4 -17
View File
@@ -52,7 +52,6 @@ module amg_c_invt_solver
contains
procedure, pass(sv) :: check => amg_c_invt_solver_check
procedure, pass(sv) :: clone => amg_c_invt_solver_clone
procedure, pass(sv) :: clone_settings => amg_c_invt_solver_clone_settings
procedure, pass(sv) :: build => amg_c_invt_solver_bld
procedure, pass(sv) :: cseti => amg_c_invt_solver_cseti
procedure, pass(sv) :: csetr => amg_c_invt_solver_csetr
@@ -74,17 +73,6 @@ module amg_c_invt_solver
end subroutine amg_c_invt_solver_clone
end interface
interface
subroutine amg_c_invt_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& amg_c_base_solver_type, psb_spk_, amg_c_invt_solver_type, psb_ipk_
Implicit None
class(amg_c_invt_solver_type), intent(inout) :: sv
class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_invt_solver_clone_settings
end interface
interface
subroutine amg_c_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
@@ -146,17 +134,16 @@ module amg_c_invt_solver
end interface
interface
subroutine amg_c_invt_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_c_invt_solver_descr(sv,info,iout,coarse)
import :: psb_spk_, amg_c_invt_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_c_invt_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine amg_c_invt_solver_descr
end interface
amgprec/amg_c_jac_smoother.f90
+6 -8
View File
@@ -219,13 +219,12 @@ module amg_c_jac_smoother
end interface
interface
subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse,prefix)
subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse)
import :: amg_c_jac_smoother_type, psb_ipk_
class(amg_c_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
end subroutine amg_c_jac_smoother_descr
end interface
@@ -314,13 +313,12 @@ module amg_c_jac_smoother
end interface
interface
subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse)
import :: amg_c_l1_jac_smoother_type, psb_ipk_
class(amg_c_l1_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine amg_c_l1_jac_smoother_descr
end interface
amgprec/amg_c_jac_solver.f90
-585
View File
@@ -1,585 +0,0 @@
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
! File: amg_c_jac_solver_mod.f90
!
! Module: amg_c_jac_solver_mod
!
! This module defines:
! - the amg_c_jac_solver_type data structure containing the ingredients
! for a local Jacobi iteration. The iterations are local to a process
! (they operate on the block diagonal).
!
!
module amg_c_jac_solver
use amg_c_base_solver_mod
type, extends(amg_c_base_solver_type) :: amg_c_jac_solver_type
type(psb_cspmat_type) :: a
type(psb_c_vect_type), allocatable :: dv
complex(psb_spk_), allocatable :: d(:)
integer(psb_ipk_) :: sweeps
real(psb_spk_) :: eps
contains
procedure, pass(sv) :: dump => amg_c_jac_solver_dmp
procedure, pass(sv) :: check => c_jac_solver_check
procedure, pass(sv) :: clone => amg_c_jac_solver_clone
procedure, pass(sv) :: clone_settings => amg_c_jac_solver_clone_settings
procedure, pass(sv) :: clear_data => amg_c_jac_solver_clear_data
procedure, pass(sv) :: build => amg_c_jac_solver_bld
procedure, pass(sv) :: cnv => amg_c_jac_solver_cnv
procedure, pass(sv) :: apply_v => amg_c_jac_solver_apply_vect
procedure, pass(sv) :: apply_a => amg_c_jac_solver_apply
procedure, pass(sv) :: free => c_jac_solver_free
procedure, pass(sv) :: cseti => c_jac_solver_cseti
procedure, pass(sv) :: csetc => c_jac_solver_csetc
procedure, pass(sv) :: csetr => c_jac_solver_csetr
procedure, pass(sv) :: descr => c_jac_solver_descr
procedure, pass(sv) :: default => c_jac_solver_default
procedure, pass(sv) :: sizeof => c_jac_solver_sizeof
procedure, pass(sv) :: get_nzeros => c_jac_solver_get_nzeros
procedure, nopass :: get_wrksz => c_jac_solver_get_wrksize
procedure, nopass :: get_fmt => c_jac_solver_get_fmt
procedure, nopass :: get_id => c_jac_solver_get_id
procedure, nopass :: is_iterative => c_jac_solver_is_iterative
end type amg_c_jac_solver_type
type, extends(amg_c_jac_solver_type) :: amg_c_l1_jac_solver_type
contains
procedure, pass(sv) :: build => amg_c_l1_jac_solver_bld
procedure, pass(sv) :: descr => c_l1_jac_solver_descr
procedure, nopass :: get_fmt => c_l1_jac_solver_get_fmt
procedure, nopass :: get_id => c_l1_jac_solver_get_id
end type amg_c_l1_jac_solver_type
private :: c_jac_solver_bld, c_jac_solver_apply, &
& c_jac_solver_free, &
& c_jac_solver_descr, c_jac_solver_sizeof, &
& c_jac_solver_default, c_jac_solver_dmp, &
& c_jac_solver_apply_vect, c_jac_solver_get_nzeros, &
& c_jac_solver_get_fmt, c_jac_solver_check,&
& c_jac_solver_is_iterative, &
& c_jac_solver_get_id, c_jac_solver_get_wrksize
interface
subroutine amg_c_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,wv,info,init,initu)
import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_c_jac_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu
end subroutine amg_c_jac_solver_apply_vect
end interface
interface
subroutine amg_c_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_c_jac_solver_type), intent(inout) :: sv
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
complex(psb_spk_),intent(inout), optional :: initu(:)
end subroutine amg_c_jac_solver_apply
end interface
interface
subroutine amg_c_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_c_jac_solver_bld
end interface
interface
subroutine amg_c_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_c_l1_jac_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_c_l1_jac_solver_bld
end interface
interface
subroutine amg_c_jac_solver_cnv(sv,info,amold,vmold,imold)
import :: amg_c_jac_solver_type, psb_spk_, &
& psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
class(amg_c_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_c_jac_solver_cnv
end interface
interface
subroutine amg_c_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, &
& psb_ipk_
implicit none
class(amg_c_jac_solver_type), intent(in) :: sv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver, global_num
end subroutine amg_c_jac_solver_dmp
end interface
interface
subroutine amg_c_jac_solver_clone(sv,svout,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_solver_type, amg_c_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_jac_solver_clone
end interface
!!$ interface
!!$ subroutine amg_c_l1_jac_solver_clone(sv,svout,info)
!!$ import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
!!$ & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
!!$ & amg_c_base_solver_type, amg_c_l1_jac_solver_type, psb_ipk_
!!$ Implicit None
!!$
!!$ ! Arguments
!!$ class(amg_c_l1_jac_solver_type), intent(inout) :: sv
!!$ class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_c_l1_jac_solver_clone
!!$ end interface
interface
subroutine amg_c_jac_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_solver_type, amg_c_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
class(amg_c_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_jac_solver_clone_settings
end interface
interface
subroutine amg_c_jac_solver_clear_data(sv,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_jac_solver_clear_data
end interface
contains
subroutine c_jac_solver_default(sv)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
sv%sweeps = ione
sv%eps = dzero
return
end subroutine c_jac_solver_default
subroutine c_jac_solver_check(sv,info)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_jac_solver_check'
call psb_erractionsave(err_act)
info = psb_success_
call amg_check_def(sv%sweeps,&
& 'Jacobi sweeps',ione,is_int_positive)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_jac_solver_check
subroutine c_jac_solver_cseti(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_jac_solver_cseti'
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(what))
case('SOLVER_SWEEPS')
sv%sweeps = val
case default
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_jac_solver_cseti
subroutine c_jac_solver_csetc(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='c_jac_solver_csetc'
info = psb_success_
call psb_erractionsave(err_act)
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info, name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_jac_solver_csetc
subroutine c_jac_solver_csetr(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_jac_solver_csetr'
call psb_erractionsave(err_act)
info = psb_success_
select case(psb_toupper(what))
case('SOLVER_EPS')
sv%eps = val
case default
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_jac_solver_csetr
subroutine c_jac_solver_free(sv,info)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_jac_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
call sv%a%free()
if (allocated(sv%dv)) then
call sv%dv%free(info)
deallocate(sv%dv)
end if
if (allocated(sv%d)) deallocate(sv%d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_jac_solver_free
subroutine c_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_jac_solver_descr
function c_jac_solver_get_nzeros(sv) result(val)
implicit none
! Arguments
class(amg_c_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = 0
val = val + sv%a%get_nzeros()
val = val + sv%dv%get_nrows()
return
end function c_jac_solver_get_nzeros
function c_jac_solver_sizeof(sv) result(val)
implicit none
! Arguments
class(amg_c_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = psb_sizeof_ip
val = val + sv%a%sizeof()
val = val + sv%dv%sizeof()
return
end function c_jac_solver_sizeof
function c_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Jacobi solver"
end function c_jac_solver_get_fmt
function c_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_jac_
end function c_jac_solver_get_id
!
! If this is true, then the solver needs a starting
! guess. Currently only handled in JAC smoother.
!
function c_jac_solver_is_iterative() result(val)
implicit none
logical :: val
val = .true.
end function c_jac_solver_is_iterative
function c_jac_solver_get_wrksize() result(val)
implicit none
integer(psb_ipk_) :: val
val = 2
end function c_jac_solver_get_wrksize
subroutine c_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_c_l1_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_l1_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_l1_jac_solver_descr
function c_l1_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "L1-Jacobi solver"
end function c_l1_jac_solver_get_fmt
function c_l1_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_l1_jac_
end function c_l1_jac_solver_get_id
end module amg_c_jac_solver
amgprec/amg_c_krm_solver.f90
+15 -16
View File
@@ -436,7 +436,7 @@ contains
val = "KRM solver"
end function c_krm_solver_get_fmt
subroutine c_krm_solver_descr(sv,info,iout,coarse,prefix)
subroutine c_krm_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -444,14 +444,12 @@ contains
class(amg_c_krm_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_krm_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -460,22 +458,23 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%global) then
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
write(iout_,*) ' Krylov solver (global)'
else
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
write(iout_,*) ' Krylov solver (local) '
end if
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
write(iout_,*) ' method: ',sv%method
write(iout_,*) ' kprec: ',sv%kprec
if (sv%i_sub_solve > 0) then
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
else
write(iout_,*) ' sub_solve: ',sv%sub_solve
end if
write(iout_,*) ' itmax: ',sv%itmax
write(iout_,*) ' eps: ',sv%eps
write(iout_,*) ' fillin: ',sv%fillin
call psb_erractionrestore(err_act)
return
amgprec/amg_c_mumps_solver.F90
+7 -15
View File
@@ -78,8 +78,7 @@ module amg_c_mumps_solver
!
! Controls to be set before MUMPS instantiation:
!
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: 'LOCAL_SOLVER
! 1==amg_global_solver_: 'GLOBAL_SOLVER'
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: LOCAL 1==amg_global_solver_: GLOBAL
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
integer(psb_ipk_), dimension(3) :: ipar
@@ -314,24 +313,22 @@ subroutine c_mumps_solver_finalize(sv)
end subroutine c_mumps_solver_finalize
subroutine c_mumps_solver_descr(sv,info,iout,coarse,prefix)
subroutine c_mumps_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_c_mumps_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -340,13 +337,8 @@ subroutine c_mumps_solver_descr(sv,info,iout,coarse,prefix)
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
write(iout_,*) ' MUMPS Solver. '
call psb_erractionrestore(err_act)
return
amgprec/amg_c_onelev_mod.f90
+2 -34
View File
@@ -187,10 +187,8 @@ module amg_c_onelev_mod
procedure, pass(lv) :: clone => c_base_onelev_clone
procedure, pass(lv) :: cnv => amg_c_base_onelev_cnv
procedure, pass(lv) :: descr => amg_c_base_onelev_descr
procedure, pass(lv) :: memory_use => amg_c_base_onelev_memory_use
procedure, pass(lv) :: default => c_base_onelev_default
procedure, pass(lv) :: free => amg_c_base_onelev_free
procedure, pass(lv) :: free_smoothers => amg_c_base_onelev_free_smoothers
procedure, pass(lv) :: nullify => c_base_onelev_nullify
procedure, pass(lv) :: check => amg_c_base_onelev_check
procedure, pass(lv) :: dump => amg_c_base_onelev_dump
@@ -259,7 +257,7 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@@ -270,27 +268,9 @@ module amg_c_onelev_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_c_base_onelev_descr
end interface
interface
subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_c_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_c_base_onelev_memory_use
end interface
interface
subroutine amg_c_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_c_onelev_type, psb_c_base_vect_type, psb_spk_, &
@@ -304,7 +284,7 @@ module amg_c_onelev_mod
end subroutine amg_c_base_onelev_cnv
end interface
interface
interface
subroutine amg_c_base_onelev_free(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
@@ -316,18 +296,6 @@ module amg_c_onelev_mod
end subroutine amg_c_base_onelev_free
end interface
interface
subroutine amg_c_base_onelev_free_smoothers(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none
class(amg_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_base_onelev_free_smoothers
end interface
interface
subroutine amg_c_base_onelev_check(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
amgprec/amg_c_prec_type.f90
+3 -93
View File
@@ -135,11 +135,8 @@ module amg_c_prec_type
procedure, pass(prec) :: build => amg_cprecbld
procedure, pass(prec) :: hierarchy_build => amg_c_hierarchy_bld
procedure, pass(prec) :: hierarchy_rebuild => amg_c_hierarchy_rebld
procedure, pass(prec) :: hierarchy_free => amg_c_hierarchy_free
procedure, pass(prec) :: smoothers_build => amg_c_smoothers_bld
procedure, pass(prec) :: smoothers_free => amg_c_smoothers_free
procedure, pass(prec) :: descr => amg_cfile_prec_descr
procedure, pass(prec) :: memory_use => amg_cfile_prec_memory_use
end type amg_cprec_type
private :: amg_c_dump, amg_c_get_compl, amg_c_cmp_compl,&
@@ -158,35 +155,18 @@ module amg_c_prec_type
interface amg_precdescr
subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity,prefix)
subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity)
import :: amg_cprec_type, psb_ipk_
implicit none
! Arguments
class(amg_cprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
class(amg_cprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_cfile_prec_descr
end interface
interface amg_memory_use
subroutine amg_cfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
import :: amg_cprec_type, psb_ipk_
implicit none
! Arguments
class(amg_cprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_cfile_prec_memory_use
end interface
interface amg_sizeof
module procedure amg_cprec_sizeof
end interface
@@ -364,14 +344,6 @@ module amg_c_prec_type
end subroutine amg_c_smoothers_bld
end interface amg_smoothers_bld
interface amg_smoothers_free
module procedure amg_c_smoothers_free
end interface amg_smoothers_free
interface amg_hierarchy_free
module procedure amg_c_hierarchy_free
end interface amg_hierarchy_free
contains
!
! Function returning a pointer to the smoother
@@ -645,68 +617,6 @@ contains
end subroutine amg_c_prec_free
subroutine amg_c_smoothers_free(prec,info)
implicit none
! Arguments
class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
info=psb_success_
name = 'amg_c_smoothers_free'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
call prec%precv(i)%free_smoothers(info)
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_c_smoothers_free
subroutine amg_c_hierarchy_free(prec,info)
implicit none
! Arguments
class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
info=psb_success_
name = 'amg_c_hierarchy_free'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
write(0,*) 'Missing implementation '
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_c_hierarchy_free
!
amgprec/amg_c_slu_solver.F90
+5 -12
View File
@@ -385,22 +385,20 @@ contains
end subroutine c_slu_solver_finalize
subroutine c_slu_solver_descr(sv,info,iout,coarse,prefix)
subroutine c_slu_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_c_slu_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
character(len=20), parameter :: name='amg_c_slu_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -409,13 +407,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return
amgprec/amg_c_symdec_aggregator_mod.f90
+4 -13
View File
@@ -88,25 +88,16 @@ contains
val = "Symmetric Decoupled aggregation"
end function amg_c_symdec_aggregator_fmt
subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_c_symdec_aggregator_type), intent(in) :: ag
type(amg_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_c_symdec_aggregator_descr
amgprec/amg_d_ainv_solver.F90
+2 -13
View File
@@ -58,7 +58,6 @@ module amg_d_ainv_solver
procedure, pass(sv) :: check => amg_d_ainv_solver_check
procedure, pass(sv) :: build => amg_d_ainv_solver_bld
procedure, pass(sv) :: clone => amg_d_ainv_solver_clone
procedure, pass(sv) :: clone_settings => amg_d_ainv_solver_clone_settings
procedure, pass(sv) :: cseti => amg_d_ainv_solver_cseti
procedure, pass(sv) :: csetc => amg_d_ainv_solver_csetc
procedure, pass(sv) :: csetr => amg_d_ainv_solver_csetr
@@ -86,16 +85,6 @@ module amg_d_ainv_solver
end subroutine amg_d_ainv_solver_clone
end interface
interface
subroutine amg_d_ainv_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& amg_d_base_solver_type, psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
Implicit None
class(amg_d_ainv_solver_type), intent(inout) :: sv
class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_ainv_solver_clone_settings
end interface
interface
subroutine amg_d_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
@@ -209,7 +198,7 @@ module amg_d_ainv_solver
!!$ end interface
interface
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
Implicit None
@@ -219,7 +208,7 @@ module amg_d_ainv_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_d_ainv_solver_descr
end interface
amgprec/amg_d_as_smoother.f90
+9 -16
View File
@@ -396,23 +396,21 @@ contains
end subroutine d_as_smoother_default
subroutine d_as_smoother_descr(sm,info,iout,coarse,prefix)
subroutine d_as_smoother_descr(sm,info,iout,coarse)
Implicit None
! Arguments
class(amg_d_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_as_smoother_descr'
integer(psb_ipk_) :: iout_
logical :: coarse_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -426,21 +424,16 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (.not.coarse_) then
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
write(iout_,*) ' Additive Schwarz with ',&
& sm%novr, ' overlap layers.'
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) trim(prefix_), ' Local solver:'
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) ' Local solver:'
endif
if (allocated(sm%sv)) then
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
call sm%sv%descr(info,iout_,coarse=coarse)
end if
call psb_erractionrestore(err_act)
amgprec/amg_d_base_aggregator_mod.f90
+3 -10
View File
@@ -275,22 +275,15 @@ contains
val = .false.
end function amg_d_base_aggregator_xt_desc
subroutine amg_d_base_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_d_base_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_d_base_aggregator_type), intent(in) :: ag
type(amg_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_d_base_aggregator_descr
amgprec/amg_d_base_smoother_mod.f90
+1 -2
View File
@@ -272,7 +272,7 @@ module amg_d_base_smoother_mod
end interface
interface
subroutine amg_d_base_smoother_descr(sm,info,iout,coarse,prefix)
subroutine amg_d_base_smoother_descr(sm,info,iout,coarse)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_smoother_type, psb_ipk_
@@ -281,7 +281,6 @@ module amg_d_base_smoother_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_d_base_smoother_descr
end interface
amgprec/amg_d_base_solver_mod.f90
+2 -2
View File
@@ -270,7 +270,7 @@ module amg_d_base_solver_mod
end interface
interface
subroutine amg_d_base_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_d_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_solver_type, psb_ipk_
@@ -281,7 +281,7 @@ module amg_d_base_solver_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_d_base_solver_descr
end interface
amgprec/amg_d_dec_aggregator_mod.f90
+4 -11
View File
@@ -184,23 +184,16 @@ contains
val = "Decoupled aggregation"
end function amg_d_dec_aggregator_fmt
subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_d_dec_aggregator_type), intent(in) :: ag
type(amg_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Decoupled Aggregator'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_d_dec_aggregator_descr
amgprec/amg_d_diag_solver.f90
+6 -20
View File
@@ -219,7 +219,7 @@ contains
end subroutine d_diag_solver_free
subroutine d_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -228,13 +228,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -242,13 +240,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Diagonal local solver '
write(iout_,*) ' Diagonal local solver '
return
@@ -359,7 +352,7 @@ module amg_d_l1_diag_solver
contains
subroutine d_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_l1_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -368,13 +361,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_l1_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -382,13 +373,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
write(iout_,*) ' L1 Diagonal solver '
return
amgprec/amg_d_gs_solver.f90
+12 -26
View File
@@ -433,22 +433,20 @@ contains
return
end subroutine d_gs_solver_free
subroutine d_gs_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_gs_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_d_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_gs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -457,17 +455,12 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
@@ -533,22 +526,20 @@ contains
val = .true.
end function d_gs_solver_is_iterative
subroutine d_bwgs_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_bwgs_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_d_bwgs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_bwgs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -557,17 +548,12 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
amgprec/amg_d_id_solver.f90
+3 -10
View File
@@ -157,7 +157,7 @@ contains
return
end subroutine d_id_solver_free
subroutine d_id_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_id_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -165,14 +165,12 @@ contains
class(amg_d_id_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_id_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -180,13 +178,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Identity local solver '
write(iout_,*) ' Identity local solver '
return
amgprec/amg_d_ilu_solver.f90
+14 -21
View File
@@ -234,7 +234,7 @@ contains
! Arguments
class(amg_d_ilu_solver_type), intent(inout) :: sv
sv%fact_type = amg_ilu_n_
sv%fact_type = psb_ilu_n_
sv%fill_in = 0
sv%thresh = dzero
@@ -255,13 +255,13 @@ contains
info = psb_success_
call amg_check_def(sv%fact_type,&
& 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
& 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
select case(sv%fact_type)
case(amg_ilu_n_,amg_milu_n_)
case(psb_ilu_n_,psb_milu_n_)
call amg_check_def(sv%fill_in,&
& 'Level',izero,is_int_non_negative)
case(amg_ilu_t_)
case(psb_ilu_t_)
call amg_check_def(sv%thresh,&
& 'Eps',dzero,is_legal_d_fact_thrs)
end select
@@ -406,7 +406,7 @@ contains
return
end subroutine d_ilu_solver_free
subroutine d_ilu_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_ilu_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -414,14 +414,12 @@ contains
class(amg_d_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_ilu_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -430,20 +428,15 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
write(iout_,*) ' Incomplete factorization solver: ',&
& amg_fact_names(sv%fact_type)
select case(sv%fact_type)
case(amg_ilu_n_,amg_milu_n_)
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
case(amg_ilu_t_)
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
case(psb_ilu_n_,psb_milu_n_)
write(iout_,*) ' Fill level:',sv%fill_in
case(psb_ilu_t_)
write(iout_,*) ' Fill level:',sv%fill_in
write(iout_,*) ' Fill threshold :',sv%thresh
end select
call psb_erractionrestore(err_act)
@@ -496,7 +489,7 @@ contains
implicit none
integer(psb_ipk_) :: val
val = amg_ilu_n_
val = psb_ilu_n_
end function d_ilu_solver_get_id
function d_ilu_solver_get_wrksize() result(val)
amgprec/amg_d_invk_solver.f90
+2 -14
View File
@@ -52,7 +52,6 @@ module amg_d_invk_solver
contains
procedure, pass(sv) :: check => amg_d_invk_solver_check
procedure, pass(sv) :: clone => amg_d_invk_solver_clone
procedure, pass(sv) :: clone_settings => amg_d_invk_solver_clone_settings
procedure, pass(sv) :: build => amg_d_invk_solver_bld
procedure, pass(sv) :: cseti => amg_d_invk_solver_cseti
procedure, pass(sv) :: descr => amg_d_invk_solver_descr
@@ -74,17 +73,6 @@ module amg_d_invk_solver
end subroutine amg_d_invk_solver_clone
end interface
interface
subroutine amg_d_invk_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& amg_d_base_solver_type, psb_dpk_, amg_d_invk_solver_type, psb_ipk_
Implicit None
class(amg_d_invk_solver_type), intent(inout) :: sv
class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_invk_solver_clone_settings
end interface
interface
subroutine amg_d_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
@@ -135,7 +123,7 @@ module amg_d_invk_solver
end interface
interface
subroutine amg_d_invk_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_d_invk_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_d_invk_solver_type, psb_ipk_
Implicit None
@@ -145,7 +133,7 @@ module amg_d_invk_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_d_invk_solver_descr
end interface
amgprec/amg_d_invt_solver.f90
+4 -17
View File
@@ -52,7 +52,6 @@ module amg_d_invt_solver
contains
procedure, pass(sv) :: check => amg_d_invt_solver_check
procedure, pass(sv) :: clone => amg_d_invt_solver_clone
procedure, pass(sv) :: clone_settings => amg_d_invt_solver_clone_settings
procedure, pass(sv) :: build => amg_d_invt_solver_bld
procedure, pass(sv) :: cseti => amg_d_invt_solver_cseti
procedure, pass(sv) :: csetr => amg_d_invt_solver_csetr
@@ -74,17 +73,6 @@ module amg_d_invt_solver
end subroutine amg_d_invt_solver_clone
end interface
interface
subroutine amg_d_invt_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& amg_d_base_solver_type, psb_dpk_, amg_d_invt_solver_type, psb_ipk_
Implicit None
class(amg_d_invt_solver_type), intent(inout) :: sv
class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_invt_solver_clone_settings
end interface
interface
subroutine amg_d_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
@@ -146,17 +134,16 @@ module amg_d_invt_solver
end interface
interface
subroutine amg_d_invt_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_d_invt_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_d_invt_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_d_invt_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine amg_d_invt_solver_descr
end interface
amgprec/amg_d_jac_smoother.f90
+6 -8
View File
@@ -219,13 +219,12 @@ module amg_d_jac_smoother
end interface
interface
subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse,prefix)
subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse)
import :: amg_d_jac_smoother_type, psb_ipk_
class(amg_d_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
end subroutine amg_d_jac_smoother_descr
end interface
@@ -314,13 +313,12 @@ module amg_d_jac_smoother
end interface
interface
subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse)
import :: amg_d_l1_jac_smoother_type, psb_ipk_
class(amg_d_l1_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine amg_d_l1_jac_smoother_descr
end interface
amgprec/amg_d_jac_solver.f90
-585
View File
@@ -1,585 +0,0 @@
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
! File: amg_d_jac_solver_mod.f90
!
! Module: amg_d_jac_solver_mod
!
! This module defines:
! - the amg_d_jac_solver_type data structure containing the ingredients
! for a local Jacobi iteration. The iterations are local to a process
! (they operate on the block diagonal).
!
!
module amg_d_jac_solver
use amg_d_base_solver_mod
type, extends(amg_d_base_solver_type) :: amg_d_jac_solver_type
type(psb_dspmat_type) :: a
type(psb_d_vect_type), allocatable :: dv
real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_) :: sweeps
real(psb_dpk_) :: eps
contains
procedure, pass(sv) :: dump => amg_d_jac_solver_dmp
procedure, pass(sv) :: check => d_jac_solver_check
procedure, pass(sv) :: clone => amg_d_jac_solver_clone
procedure, pass(sv) :: clone_settings => amg_d_jac_solver_clone_settings
procedure, pass(sv) :: clear_data => amg_d_jac_solver_clear_data
procedure, pass(sv) :: build => amg_d_jac_solver_bld
procedure, pass(sv) :: cnv => amg_d_jac_solver_cnv
procedure, pass(sv) :: apply_v => amg_d_jac_solver_apply_vect
procedure, pass(sv) :: apply_a => amg_d_jac_solver_apply
procedure, pass(sv) :: free => d_jac_solver_free
procedure, pass(sv) :: cseti => d_jac_solver_cseti
procedure, pass(sv) :: csetc => d_jac_solver_csetc
procedure, pass(sv) :: csetr => d_jac_solver_csetr
procedure, pass(sv) :: descr => d_jac_solver_descr
procedure, pass(sv) :: default => d_jac_solver_default
procedure, pass(sv) :: sizeof => d_jac_solver_sizeof
procedure, pass(sv) :: get_nzeros => d_jac_solver_get_nzeros
procedure, nopass :: get_wrksz => d_jac_solver_get_wrksize
procedure, nopass :: get_fmt => d_jac_solver_get_fmt
procedure, nopass :: get_id => d_jac_solver_get_id
procedure, nopass :: is_iterative => d_jac_solver_is_iterative
end type amg_d_jac_solver_type
type, extends(amg_d_jac_solver_type) :: amg_d_l1_jac_solver_type
contains
procedure, pass(sv) :: build => amg_d_l1_jac_solver_bld
procedure, pass(sv) :: descr => d_l1_jac_solver_descr
procedure, nopass :: get_fmt => d_l1_jac_solver_get_fmt
procedure, nopass :: get_id => d_l1_jac_solver_get_id
end type amg_d_l1_jac_solver_type
private :: d_jac_solver_bld, d_jac_solver_apply, &
& d_jac_solver_free, &
& d_jac_solver_descr, d_jac_solver_sizeof, &
& d_jac_solver_default, d_jac_solver_dmp, &
& d_jac_solver_apply_vect, d_jac_solver_get_nzeros, &
& d_jac_solver_get_fmt, d_jac_solver_check,&
& d_jac_solver_is_iterative, &
& d_jac_solver_get_id, d_jac_solver_get_wrksize
interface
subroutine amg_d_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,wv,info,init,initu)
import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_d_jac_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu
end subroutine amg_d_jac_solver_apply_vect
end interface
interface
subroutine amg_d_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_d_jac_solver_type), intent(inout) :: sv
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
real(psb_dpk_),intent(inout), optional :: initu(:)
end subroutine amg_d_jac_solver_apply
end interface
interface
subroutine amg_d_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_d_jac_solver_bld
end interface
interface
subroutine amg_d_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_d_l1_jac_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_d_l1_jac_solver_bld
end interface
interface
subroutine amg_d_jac_solver_cnv(sv,info,amold,vmold,imold)
import :: amg_d_jac_solver_type, psb_dpk_, &
& psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
class(amg_d_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_d_jac_solver_cnv
end interface
interface
subroutine amg_d_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
& psb_ipk_
implicit none
class(amg_d_jac_solver_type), intent(in) :: sv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver, global_num
end subroutine amg_d_jac_solver_dmp
end interface
interface
subroutine amg_d_jac_solver_clone(sv,svout,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_solver_type, amg_d_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_jac_solver_clone
end interface
!!$ interface
!!$ subroutine amg_d_l1_jac_solver_clone(sv,svout,info)
!!$ import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
!!$ & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
!!$ & amg_d_base_solver_type, amg_d_l1_jac_solver_type, psb_ipk_
!!$ Implicit None
!!$
!!$ ! Arguments
!!$ class(amg_d_l1_jac_solver_type), intent(inout) :: sv
!!$ class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_d_l1_jac_solver_clone
!!$ end interface
interface
subroutine amg_d_jac_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_solver_type, amg_d_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
class(amg_d_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_jac_solver_clone_settings
end interface
interface
subroutine amg_d_jac_solver_clear_data(sv,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_jac_solver_clear_data
end interface
contains
subroutine d_jac_solver_default(sv)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
sv%sweeps = ione
sv%eps = dzero
return
end subroutine d_jac_solver_default
subroutine d_jac_solver_check(sv,info)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_jac_solver_check'
call psb_erractionsave(err_act)
info = psb_success_
call amg_check_def(sv%sweeps,&
& 'Jacobi sweeps',ione,is_int_positive)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_jac_solver_check
subroutine d_jac_solver_cseti(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_jac_solver_cseti'
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(what))
case('SOLVER_SWEEPS')
sv%sweeps = val
case default
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_jac_solver_cseti
subroutine d_jac_solver_csetc(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='d_jac_solver_csetc'
info = psb_success_
call psb_erractionsave(err_act)
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info, name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_jac_solver_csetc
subroutine d_jac_solver_csetr(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_jac_solver_csetr'
call psb_erractionsave(err_act)
info = psb_success_
select case(psb_toupper(what))
case('SOLVER_EPS')
sv%eps = val
case default
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_jac_solver_csetr
subroutine d_jac_solver_free(sv,info)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_jac_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
call sv%a%free()
if (allocated(sv%dv)) then
call sv%dv%free(info)
deallocate(sv%dv)
end if
if (allocated(sv%d)) deallocate(sv%d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_jac_solver_free
subroutine d_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_jac_solver_descr
function d_jac_solver_get_nzeros(sv) result(val)
implicit none
! Arguments
class(amg_d_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = 0
val = val + sv%a%get_nzeros()
val = val + sv%dv%get_nrows()
return
end function d_jac_solver_get_nzeros
function d_jac_solver_sizeof(sv) result(val)
implicit none
! Arguments
class(amg_d_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = psb_sizeof_ip
val = val + sv%a%sizeof()
val = val + sv%dv%sizeof()
return
end function d_jac_solver_sizeof
function d_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Jacobi solver"
end function d_jac_solver_get_fmt
function d_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_jac_
end function d_jac_solver_get_id
!
! If this is true, then the solver needs a starting
! guess. Currently only handled in JAC smoother.
!
function d_jac_solver_is_iterative() result(val)
implicit none
logical :: val
val = .true.
end function d_jac_solver_is_iterative
function d_jac_solver_get_wrksize() result(val)
implicit none
integer(psb_ipk_) :: val
val = 2
end function d_jac_solver_get_wrksize
subroutine d_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_d_l1_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_l1_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_l1_jac_solver_descr
function d_l1_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "L1-Jacobi solver"
end function d_l1_jac_solver_get_fmt
function d_l1_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_l1_jac_
end function d_l1_jac_solver_get_id
end module amg_d_jac_solver
amgprec/amg_d_krm_solver.f90
+15 -16
View File
@@ -436,7 +436,7 @@ contains
val = "KRM solver"
end function d_krm_solver_get_fmt
subroutine d_krm_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_krm_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -444,14 +444,12 @@ contains
class(amg_d_krm_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_krm_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -460,22 +458,23 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%global) then
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
write(iout_,*) ' Krylov solver (global)'
else
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
write(iout_,*) ' Krylov solver (local) '
end if
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
write(iout_,*) ' method: ',sv%method
write(iout_,*) ' kprec: ',sv%kprec
if (sv%i_sub_solve > 0) then
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
else
write(iout_,*) ' sub_solve: ',sv%sub_solve
end if
write(iout_,*) ' itmax: ',sv%itmax
write(iout_,*) ' eps: ',sv%eps
write(iout_,*) ' fillin: ',sv%fillin
call psb_erractionrestore(err_act)
return
amgprec/amg_d_matchboxp_mod.f90
+13 -41
View File
@@ -143,10 +143,9 @@ contains
type(psb_ld_coo_sparse_mat) :: tmpcoo
logical :: display_out_, print_out_, reproducible_
logical, parameter :: dump=.false., debug=.false., dump_mate=.false., &
& debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
& debug_ilaggr=.false., debug_sync=.false.
integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
logical, parameter :: do_timings=.true.
integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
ictxt = desc_a%get_ctxt()
call psb_info(ictxt,iam,np)
@@ -188,7 +187,7 @@ contains
call desc_a%l2gip(ilv,info,owned=.false.)
call psb_geall(ilaggr,desc_a,info)
ilaggr = ilaggr_neginit
ilaggr = -1
call psb_geasb(ilaggr,desc_a,info)
nr = a%get_nrows()
nc = a%get_ncols()
@@ -214,20 +213,7 @@ contains
call psb_barrier(ictxt)
if (iam == 0) write(0,*)' out from buildmatching:', info
end if
if (debug_mate) then
block
integer(psb_lpk_), allocatable :: ckmate(:)
allocate(ckmate(nr))
ckmate(1:nr) = mate(1:nr)
call psb_msort(ckmate(1:nr))
do i=1,nr-1
if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
write(0,*) iam,' Duplicate mate entry at',i,' :',ckmate(i)
end if
end do
end block
end if
if (info == 0) then
if (do_timings) call psb_tic(idx_phase2)
if (debug_sync) then
@@ -273,7 +259,7 @@ contains
cycle
else
if (ilaggr(k) == ilaggr_neginit) then
if (ilaggr(k) == -1) then
wk = w(k)
widx = w(idx)
@@ -281,7 +267,7 @@ contains
nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
if (nrmagg > epsilon(nrmagg)) then
if (idx <= nr) then
if (ilaggr(idx) == ilaggr_neginit) then
if (ilaggr(idx) == -1) then
! Now, if both vertices are local, the aggregate is local
! (kinda obvious).
nlaggr(iam) = nlaggr(iam) + 1
@@ -289,9 +275,6 @@ contains
ilaggr(idx) = nlaggr(iam)
wtemp(k) = w(k)/nrmagg
wtemp(idx) = w(idx)/nrmagg
else
write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
&mate(idx),ilaggr(idx)
end if
nlpairs = nlpairs+1
else if (idx <= nc) then
@@ -311,7 +294,7 @@ contains
ilaggr(k) = nlaggr(iam)
nlpairs = nlpairs+1
else
ilaggr(k) = ilaggr_nonlocal
ilaggr(k) = -2
end if
else
! Use a statistically unbiased tie-breaking rule,
@@ -326,7 +309,7 @@ contains
ilaggr(k) = nlaggr(iam)
nlpairs = nlpairs+1
else
ilaggr(k) = ilaggr_nonlocal
ilaggr(k) = -2
end if
end if
end if
@@ -342,12 +325,6 @@ contains
nlsingl = nlsingl + 1
end if
end if
if (ilaggr(k) == ilaggr_neginit) then
write(0,*) iam,' Error: no update to ',k,mate(k),&
& abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
end if
else
if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
end if
end if
end do
@@ -355,7 +332,7 @@ contains
if (do_timings) call psb_tic(idx_phase3)
! Ok, now compute offsets, gather halo and fix non-local
! aggregates (those where ilaggr == ilaggr_nonlocal)
! aggregates (those where ilaggr == -2)
call psb_sum(ictxt,nlaggr)
ntaggr = sum(nlaggr(0:np-1))
naggrm1 = sum(nlaggr(0:iam-1))
@@ -370,7 +347,7 @@ contains
call psb_halo(wtemp,desc_a,info)
! Cleanup as yet unmarked entries
do k=1,nr
if (ilaggr(k) == ilaggr_nonlocal) then
if (ilaggr(k) == -2) then
idx = mate(k)
if (idx > nr) then
i = ilaggr(idx)
@@ -382,14 +359,9 @@ contains
else
write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
end if
else if (ilaggr(k) <0) then
write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
write(0,*) iam,' : : ',nr,nc,mate(k)
if (mate(k) <= nr) then
write(0,*) iam,' : : ',ilaggr(mate(k)),mate(mate(k)),&
& ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
end if
flush(0)
end if
if (ilaggr(k) <0) then
write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
end if
end do
if (debug_sync) then
@@ -442,7 +414,7 @@ contains
end block
if (iam == 0) then
write(0,*) iam,'Matching statistics: Unmatched nodes ',&
write(0,*) 'Matching statistics: Unmatched nodes ',&
& nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
end if
amgprec/amg_d_mumps_solver.F90
+7 -15
View File
@@ -78,8 +78,7 @@ module amg_d_mumps_solver
!
! Controls to be set before MUMPS instantiation:
!
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: 'LOCAL_SOLVER
! 1==amg_global_solver_: 'GLOBAL_SOLVER'
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: LOCAL 1==amg_global_solver_: GLOBAL
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
integer(psb_ipk_), dimension(3) :: ipar
@@ -314,24 +313,22 @@ subroutine d_mumps_solver_finalize(sv)
end subroutine d_mumps_solver_finalize
subroutine d_mumps_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_mumps_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_d_mumps_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -340,13 +337,8 @@ subroutine d_mumps_solver_descr(sv,info,iout,coarse,prefix)
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
write(iout_,*) ' MUMPS Solver. '
call psb_erractionrestore(err_act)
return
amgprec/amg_d_onelev_mod.f90
+2 -34
View File
@@ -188,10 +188,8 @@ module amg_d_onelev_mod
procedure, pass(lv) :: clone => d_base_onelev_clone
procedure, pass(lv) :: cnv => amg_d_base_onelev_cnv
procedure, pass(lv) :: descr => amg_d_base_onelev_descr
procedure, pass(lv) :: memory_use => amg_d_base_onelev_memory_use
procedure, pass(lv) :: default => d_base_onelev_default
procedure, pass(lv) :: free => amg_d_base_onelev_free
procedure, pass(lv) :: free_smoothers => amg_d_base_onelev_free_smoothers
procedure, pass(lv) :: nullify => d_base_onelev_nullify
procedure, pass(lv) :: check => amg_d_base_onelev_check
procedure, pass(lv) :: dump => amg_d_base_onelev_dump
@@ -260,7 +258,7 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@@ -271,27 +269,9 @@ module amg_d_onelev_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_d_base_onelev_descr
end interface
interface
subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_d_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_d_base_onelev_memory_use
end interface
interface
subroutine amg_d_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_d_onelev_type, psb_d_base_vect_type, psb_dpk_, &
@@ -305,7 +285,7 @@ module amg_d_onelev_mod
end subroutine amg_d_base_onelev_cnv
end interface
interface
interface
subroutine amg_d_base_onelev_free(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
@@ -317,18 +297,6 @@ module amg_d_onelev_mod
end subroutine amg_d_base_onelev_free
end interface
interface
subroutine amg_d_base_onelev_free_smoothers(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none
class(amg_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_base_onelev_free_smoothers
end interface
interface
subroutine amg_d_base_onelev_check(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
amgprec/amg_d_parmatch_aggregator_mod.F90
+6 -13
View File
@@ -390,25 +390,18 @@ contains
end function amg_d_parmatch_aggregator_sizeof
subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_d_parmatch_aggregator_type), intent(in) :: ag
type(amg_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps
write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Parallel Matching Aggregator'
write(iout,*) ' Number of matching sweeps: ',ag%n_sweeps
write(iout,*) ' Matching algorithm : MatchBoxP (PREIS)'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_d_parmatch_aggregator_descr
amgprec/amg_d_poly_coeff_mod.f90
-548
View File
@@ -1,548 +0,0 @@
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
! File: amg_d_poly_smoother_mod.f90
!
! Module: amg_d_poly_smoother_mod
!
! This module defines:
! the amg_d_poly_smoother_type data structure containing the
! smoother for a Jacobi/block Jacobi smoother.
! The smoother stores in ND the block off-diagonal matrix.
! One special case is treated separately, when the solver is DIAG or L1-DIAG
! then the ND is the entire off-diagonal part of the matrix (including the
! main diagonal block), so that it becomes possible to implement
! a pure Jacobi or L1-Jacobi global solver.
!
module amg_d_poly_coeff_mod
use psb_base_mod
real(psb_dpk_), parameter :: amg_d_poly_a_vect(30) = [ &
& 0.3333333333333333_psb_dpk_, &
& 0.1805359927403007_psb_dpk_, &
& 0.1159278464862213_psb_dpk_, &
& 0.0820780659590383_psb_dpk_, &
& 0.0618496002413377_psb_dpk_, &
& 0.0486605823426062_psb_dpk_, &
& 0.0395132986024057_psb_dpk_, &
& 0.0328701017544880_psb_dpk_, &
& 0.0278702862721800_psb_dpk_, &
& 0.0239987409600620_psb_dpk_, &
& 0.0209304400432259_psb_dpk_, &
& 0.0184513099045066_psb_dpk_, &
& 0.0164152586042591_psb_dpk_, &
& 0.0147195638076874_psb_dpk_, &
& 0.0132901324757843_psb_dpk_, &
& 0.0120723317737698_psb_dpk_, &
& 0.0110250964606384_psb_dpk_, &
& 0.0101170330064859_psb_dpk_, &
& 0.0093237789039835_psb_dpk_, &
& 0.0086261728849515_psb_dpk_, &
& 0.0080089618703679_psb_dpk_, &
& 0.0074598709610601_psb_dpk_, &
& 0.0069689238144320_psb_dpk_, &
& 0.0065279387776372_psb_dpk_, &
& 0.0061301503808627_psb_dpk_, &
& 0.0057699215598864_psb_dpk_, &
& 0.0054425224281914_psb_dpk_, &
& 0.0051439584672521_psb_dpk_, &
& 0.0048708358327268_psb_dpk_, &
& 0.0046202548314912_psb_dpk_ ];
real(psb_dpk_), parameter :: amg_d_poly_beta_vect(900) = [ &
& 1.1250000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0238728757031315_psb_dpk_, 1.2640890537108553_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0084254478202830_psb_dpk_, 1.0886783920873087_psb_dpk_, &
& 1.3375312590961856_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0039131042728535_psb_dpk_, 1.0403581118859304_psb_dpk_, &
& 1.1486349854625493_psb_dpk_, 1.3826886924100055_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0021293014616472_psb_dpk_, 1.0217371154926094_psb_dpk_, &
& 1.0787243319260302_psb_dpk_, 1.1981006529266300_psb_dpk_, &
& 1.4132254279168215_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0012851725594023_psb_dpk_, 1.0130429303523338_psb_dpk_, &
& 1.0467821512411335_psb_dpk_, 1.1161648941967548_psb_dpk_, &
& 1.2382902021844453_psb_dpk_, 1.4352429710674484_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0008346439791242_psb_dpk_, 1.0084394943012289_psb_dpk_, &
& 1.0300870776871385_psb_dpk_, 1.0740838409200377_psb_dpk_, &
& 1.1503618670736642_psb_dpk_, 1.2711647404613990_psb_dpk_, &
& 1.4518665864936395_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0005724663119766_psb_dpk_, 1.0057742766241562_psb_dpk_, &
& 1.0205018792294143_psb_dpk_, 1.0501980344456543_psb_dpk_, &
& 1.1011557298494106_psb_dpk_, 1.1808604280685657_psb_dpk_, &
& 1.2983858538257604_psb_dpk_, 1.4648607315109978_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0004096007283281_psb_dpk_, 1.0041243950610661_psb_dpk_, &
& 1.0146021214826659_psb_dpk_, 1.0356111362667175_psb_dpk_, &
& 1.0713997252919425_psb_dpk_, 1.1268827371096291_psb_dpk_, &
& 1.2078521914072933_psb_dpk_, 1.3212193071674674_psb_dpk_, &
& 1.4752964282069962_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0003031222965291_psb_dpk_, 1.0030484066079688_psb_dpk_, &
& 1.0107702271538761_psb_dpk_, 1.0261901159764004_psb_dpk_, &
& 1.0523172493375519_psb_dpk_, 1.0925574320754976_psb_dpk_, &
& 1.1508337666397197_psb_dpk_, 1.2317225087089441_psb_dpk_, &
& 1.3406080202445980_psb_dpk_, 1.4838612440701109_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0002305859520939_psb_dpk_, 1.0023167502402850_psb_dpk_, &
& 1.0081724539630488_psb_dpk_, 1.0198298656634219_psb_dpk_, &
& 1.0395021023532465_psb_dpk_, 1.0696504270054137_psb_dpk_, &
& 1.1130575429574259_psb_dpk_, 1.1729087627556418_psb_dpk_, &
& 1.2528830057679230_psb_dpk_, 1.3572557991951903_psb_dpk_, &
& 1.4910167256413891_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0001794720082837_psb_dpk_, 1.0018018913961957_psb_dpk_, &
& 1.0063486190730762_psb_dpk_, 1.0153786456630600_psb_dpk_, &
& 1.0305694283076039_psb_dpk_, 1.0537601969394355_psb_dpk_, &
& 1.0869986259207296_psb_dpk_, 1.1325918309791341_psb_dpk_, &
& 1.1931627335817252_psb_dpk_, 1.2717129367511055_psb_dpk_, &
& 1.3716933796979953_psb_dpk_, 1.4970841857556243_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0001424192155957_psb_dpk_, 1.0014290693262966_psb_dpk_, &
& 1.0050302898629815_psb_dpk_, 1.0121691051849540_psb_dpk_, &
& 1.0241487434279255_psb_dpk_, 1.0423815888082042_psb_dpk_, &
& 1.0684200812870084_psb_dpk_, 1.1039901093675994_psb_dpk_, &
& 1.1510274824264566_psb_dpk_, 1.2117181191012512_psb_dpk_, &
& 1.2885426486512805_psb_dpk_, 1.3843261938099158_psb_dpk_, &
& 1.5022941875736890_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0001149053826193_psb_dpk_, 1.0011524637691460_psb_dpk_, &
& 1.0040535733326481_psb_dpk_, 1.0097959057315313_psb_dpk_, &
& 1.0194130047299461_psb_dpk_, 1.0340142503543679_psb_dpk_, &
& 1.0548059960662932_psb_dpk_, 1.0831142030181304_psb_dpk_, &
& 1.1204089166089239_psb_dpk_, 1.1683309565544606_psb_dpk_, &
& 1.2287212228823874_psb_dpk_, 1.3036530570781755_psb_dpk_, &
& 1.3954681405367855_psb_dpk_, 1.5068164620958386_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000940475075257_psb_dpk_, 1.0009429169634352_psb_dpk_, &
& 1.0033144905644482_psb_dpk_, 1.0080029483381612_psb_dpk_, &
& 1.0158423625914039_psb_dpk_, 1.0277208331770495_psb_dpk_, &
& 1.0445953542283146_psb_dpk_, 1.0675076120612534_psb_dpk_, &
& 1.0976009254588965_psb_dpk_, 1.1361385536615733_psb_dpk_, &
& 1.1845236142623621_psb_dpk_, 1.2443208730447588_psb_dpk_, &
& 1.3172806908339272_psb_dpk_, 1.4053654389356023_psb_dpk_, &
& 1.5107787250184523_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000779482817921_psb_dpk_, 1.0007812684725339_psb_dpk_, &
& 1.0027448797440124_psb_dpk_, 1.0066229101701514_psb_dpk_, &
& 1.0130985883697137_psb_dpk_, 1.0228944832933697_psb_dpk_, &
& 1.0367832140998394_psb_dpk_, 1.0555987571989653_psb_dpk_, &
& 1.0802484840556024_psb_dpk_, 1.1117260713149764_psb_dpk_, &
& 1.1511254343107276_psb_dpk_, 1.1996558461497355_psb_dpk_, &
& 1.2586584174494597_psb_dpk_, 1.3296241265666493_psb_dpk_, &
& 1.4142136069557629_psb_dpk_, 1.5142789173034623_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000653242183546_psb_dpk_, 1.0006545722939437_psb_dpk_, &
& 1.0022987777448662_psb_dpk_, 1.0055432691173583_psb_dpk_, &
& 1.0109550075016893_psb_dpk_, 1.0191301541168694_psb_dpk_, &
& 1.0307019481191382_psb_dpk_, 1.0463489778000818_psb_dpk_, &
& 1.0668039321569163_psb_dpk_, 1.0928629244731740_psb_dpk_, &
& 1.1253954850882542_psb_dpk_, 1.1653553270075827_psb_dpk_, &
& 1.2137919954743157_psb_dpk_, 1.2718635211544003_psb_dpk_, &
& 1.3408502062615073_psb_dpk_, 1.4221696838526183_psb_dpk_, &
& 1.5173934027630227_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000552858792859_psb_dpk_, 1.0005538659610900_psb_dpk_, &
& 1.0019444166743086_psb_dpk_, 1.0046864301776393_psb_dpk_, &
& 1.0092557508630260_psb_dpk_, 1.0161502674772371_psb_dpk_, &
& 1.0258958148322650_psb_dpk_, 1.0390523408953256_psb_dpk_, &
& 1.0562203973533295_psb_dpk_, 1.0780480145522537_psb_dpk_, &
& 1.1052380250439366_psb_dpk_, 1.1385559038570177_psb_dpk_, &
& 1.1788381980793483_psb_dpk_, 1.2270016234308427_psb_dpk_, &
& 1.2840529112630572_psb_dpk_, 1.3510994958895055_psb_dpk_, &
& 1.4293611393851839_psb_dpk_, 1.5201825990516680_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000472036358790_psb_dpk_, 1.0004728102642675_psb_dpk_, &
& 1.0016593577469159_psb_dpk_, 1.0039976891368516_psb_dpk_, &
& 1.0078911941833455_psb_dpk_, 1.0137601583069535_psb_dpk_, &
& 1.0220462561721002_psb_dpk_, 1.0332172281153209_psb_dpk_, &
& 1.0477717791157513_psb_dpk_, 1.0662447417325256_psb_dpk_, &
& 1.0892125464929936_psb_dpk_, 1.1172990456131733_psb_dpk_, &
& 1.1511817386833911_psb_dpk_, 1.1915984520803475_psb_dpk_, &
& 1.2393545273929878_psb_dpk_, 1.2953305781018039_psb_dpk_, &
& 1.3604908781568688_psb_dpk_, 1.4358924509939206_psb_dpk_, &
& 1.5226949329440265_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000406232569254_psb_dpk_, 1.0004068351374691_psb_dpk_, &
& 1.0014274431564170_psb_dpk_, 1.0034377175807407_psb_dpk_, &
& 1.0067826854070978_psb_dpk_, 1.0118204999571436_psb_dpk_, &
& 1.0189259121271075_psb_dpk_, 1.0284938700470616_psb_dpk_, &
& 1.0409432748132981_psb_dpk_, 1.0567209210598594_psb_dpk_, &
& 1.0763056524407055_psb_dpk_, 1.1002127636100871_psb_dpk_, &
& 1.1289986820268283_psb_dpk_, 1.1632659648787138_psb_dpk_, &
& 1.2036686486408621_psb_dpk_, 1.2509179912601627_psb_dpk_, &
& 1.3057886497146727_psb_dpk_, 1.3691253387497200_psb_dpk_, &
& 1.4418500199624611_psb_dpk_, 1.5249696741164267_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000352114440929_psb_dpk_, 1.0003525892395289_psb_dpk_, &
& 1.0012368357172980_psb_dpk_, 1.0029777430511673_psb_dpk_, &
& 1.0058727830027672_psb_dpk_, 1.0102297507781717_psb_dpk_, &
& 1.0163694815733537_psb_dpk_, 1.0246286588536329_psb_dpk_, &
& 1.0353627340015590_psb_dpk_, 1.0489489776835172_psb_dpk_, &
& 1.0657896841306789_psb_dpk_, 1.0863155505114006_psb_dpk_, &
& 1.1109892546943501_psb_dpk_, 1.1403092559728156_psb_dpk_, &
& 1.1748138447471401_psb_dpk_, 1.2150854687543668_psb_dpk_, &
& 1.2617553651999671_psb_dpk_, 1.3155085300984379_psb_dpk_, &
& 1.3770890582780710_psb_dpk_, 1.4473058898645985_psb_dpk_, &
& 1.5270390016420912_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000307198714835_psb_dpk_, 1.0003075769178242_psb_dpk_, &
& 1.0010787281022711_psb_dpk_, 1.0025963829693492_psb_dpk_, &
& 1.0051188625231162_psb_dpk_, 1.0089126974249720_psb_dpk_, &
& 1.0142547789760521_psb_dpk_, 1.0214345766593154_psb_dpk_, &
& 1.0307564364069204_psb_dpk_, 1.0425419742322541_psb_dpk_, &
& 1.0571325804249445_psb_dpk_, 1.0748920501551993_psb_dpk_, &
& 1.0962093570737961_psb_dpk_, 1.1215015873309027_psb_dpk_, &
& 1.1512170523743910_psb_dpk_, 1.1858385999327761_psb_dpk_, &
& 1.2258871437439198_psb_dpk_, 1.2719254338660289_psb_dpk_, &
& 1.3245620908078453_psb_dpk_, 1.3844559282498121_psb_dpk_, &
& 1.4523205908039656_psb_dpk_, 1.5289295350887884_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000269609460124_psb_dpk_, 1.0002699137181752_psb_dpk_, &
& 1.0009464748475532_psb_dpk_, 1.0022775198638552_psb_dpk_, &
& 1.0044888368184179_psb_dpk_, 1.0078128087804721_psb_dpk_, &
& 1.0124901352066715_psb_dpk_, 1.0187716022931539_psb_dpk_, &
& 1.0269199126829005_psb_dpk_, 1.0372115852204526_psb_dpk_, &
& 1.0499389358225151_psb_dpk_, 1.0654121509688057_psb_dpk_, &
& 1.0839614658147161_psb_dpk_, 1.1059394594887115_psb_dpk_, &
& 1.1317234807654135_psb_dpk_, 1.1617182180038959_psb_dpk_, &
& 1.1963584280123116_psb_dpk_, 1.2361118393501820_psb_dpk_, &
& 1.2814822465106404_psb_dpk_, 1.3330128124440397_psb_dpk_, &
& 1.3912895979940381_psb_dpk_, 1.4569453380258381_psb_dpk_, &
& 1.5306634853375161_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000237911597230_psb_dpk_, 1.0002381585998457_psb_dpk_, &
& 1.0008349974382460_psb_dpk_, 1.0020088476285827_psb_dpk_, &
& 1.0039582343156432_psb_dpk_, 1.0068870298152559_psb_dpk_, &
& 1.0110058445931565_psb_dpk_, 1.0165334547611182_psb_dpk_, &
& 1.0236982737890488_psb_dpk_, 1.0327398763510158_psb_dpk_, &
& 1.0439105824804926_psb_dpk_, 1.0574771105088172_psb_dpk_, &
& 1.0737223076000839_psb_dpk_, 1.0929469670793606_psb_dpk_, &
& 1.1154717421787756_psb_dpk_, 1.1416391663018148_psb_dpk_, &
& 1.1718157904303341_psb_dpk_, 1.2063944488757254_psb_dpk_, &
& 1.2457966652063013_psb_dpk_, 1.2904752108716941_psb_dpk_, &
& 1.3409168297942540_psb_dpk_, 1.3976451430108305_psb_dpk_, &
& 1.4612237483301715_psb_dpk_, 1.5322595309246121_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000210994601235_psb_dpk_, 1.0002111968041199_psb_dpk_, &
& 1.0007403694573151_psb_dpk_, 1.0017808593384865_psb_dpk_, &
& 1.0035081686576977_psb_dpk_, 1.0061021720448531_psb_dpk_, &
& 1.0097482505685551_psb_dpk_, 1.0146384533048582_psb_dpk_, &
& 1.0209726922414943_psb_dpk_, 1.0289599764553270_psb_dpk_, &
& 1.0388196916802268_psb_dpk_, 1.0507829315895938_psb_dpk_, &
& 1.0650938873538003_psb_dpk_, 1.0820113022982043_psb_dpk_, &
& 1.1018099987843295_psb_dpk_, 1.1247824847650900_psb_dpk_, &
& 1.1512406478277994_psb_dpk_, 1.1815175449359154_psb_dpk_, &
& 1.2159692965153148_psb_dpk_, 1.2549770940040335_psb_dpk_, &
& 1.2989493304988182_psb_dpk_, 1.3483238646890843_psb_dpk_, &
& 1.4035704288718982_psb_dpk_, 1.4651931924923849_psb_dpk_, &
& 1.5337334933563860_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000187989989242_psb_dpk_, 1.0001881567984481_psb_dpk_, &
& 1.0006595227084085_psb_dpk_, 1.0015861311895899_psb_dpk_, &
& 1.0031239047778964_psb_dpk_, 1.0054323694760092_psb_dpk_, &
& 1.0086755868504005_psb_dpk_, 1.0130231071421940_psb_dpk_, &
& 1.0186509477893992_psb_dpk_, 1.0257426018654052_psb_dpk_, &
& 1.0344900810652515_psb_dpk_, 1.0450949980170887_psb_dpk_, &
& 1.0577696928624343_psb_dpk_, 1.0727384092356933_psb_dpk_, &
& 1.0902385249817814_psb_dpk_, 1.1105218431816117_psb_dpk_, &
& 1.1338559493090710_psb_dpk_, 1.1605256406217599_psb_dpk_, &
& 1.1908344341913664_psb_dpk_, 1.2251061603103259_psb_dpk_, &
& 1.2636866483695495_psb_dpk_, 1.3069455126904677_psb_dpk_, &
& 1.3552780462128098_psb_dpk_, 1.4091072303921326_psb_dpk_, &
& 1.4688858701459975_psb_dpk_, 1.5350988632115488_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000168211938973_psb_dpk_, 1.0001683505351420_psb_dpk_, &
& 1.0005900360142315_psb_dpk_, 1.0014188084960041_psb_dpk_, &
& 1.0027938311393803_psb_dpk_, 1.0048572584314193_psb_dpk_, &
& 1.0077550080990554_psb_dpk_, 1.0116375492127350_psb_dpk_, &
& 1.0166607098595459_psb_dpk_, 1.0229865078405374_psb_dpk_, &
& 1.0307840079371537_psb_dpk_, 1.0402302093961155_psb_dpk_, &
& 1.0515109674005423_psb_dpk_, 1.0648219524284319_psb_dpk_, &
& 1.0803696515480321_psb_dpk_, 1.0983724158638981_psb_dpk_, &
& 1.1190615585080472_psb_dpk_, 1.1426825077681895_psb_dpk_, &
& 1.1694960201606786_psb_dpk_, 1.1997794584895700_psb_dpk_, &
& 1.2338281401870808_psb_dpk_, 1.2719567615042522_psb_dpk_, &
& 1.3145009034164739_psb_dpk_, 1.3618186254259919_psb_dpk_, &
& 1.4142921537855777_psb_dpk_, 1.4723296710339275_psb_dpk_, &
& 1.5363672141264497_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000151113991291_psb_dpk_, 1.0001512299115287_psb_dpk_, &
& 1.0005299814085029_psb_dpk_, 1.0012742317597600_psb_dpk_, &
& 1.0025087130476142_psb_dpk_, 1.0043606572645858_psb_dpk_, &
& 1.0069604400315522_psb_dpk_, 1.0104422369100252_psb_dpk_, &
& 1.0149446949285030_psb_dpk_, 1.0206116219981500_psb_dpk_, &
& 1.0275926969588451_psb_dpk_, 1.0360442030716124_psb_dpk_, &
& 1.0461297878595799_psb_dpk_, 1.0580212522952626_psb_dpk_, &
& 1.0718993724396861_psb_dpk_, 1.0879547567564958_psb_dpk_, &
& 1.1063887424550545_psb_dpk_, 1.1274143343577541_psb_dpk_, &
& 1.1512571899424711_psb_dpk_, 1.1781566543781672_psb_dpk_, &
& 1.2083668495540898_psb_dpk_, 1.2421578212983135_psb_dpk_, &
& 1.2798167491932815_psb_dpk_, 1.3216492236219661_psb_dpk_, &
& 1.3679805949228399_psb_dpk_, 1.4191573997915068_psb_dpk_, &
& 1.4755488703473389_psb_dpk_, 1.5375485315807513_psb_dpk_, &
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000136257096588_psb_dpk_, 1.0001363546506836_psb_dpk_, &
& 1.0004778107488095_psb_dpk_, 1.0011486612681773_psb_dpk_, &
& 1.0022611433613271_psb_dpk_, 1.0039295964948667_psb_dpk_, &
& 1.0062710027404669_psb_dpk_, 1.0094055369479136_psb_dpk_, &
& 1.0134571288503909_psb_dpk_, 1.0185540391932908_psb_dpk_, &
& 1.0248294520252528_psb_dpk_, 1.0324220853457433_psb_dpk_, &
& 1.0414768223656390_psb_dpk_, 1.0521453657079123_psb_dpk_, &
& 1.0645869169533493_psb_dpk_, 1.0789688840227822_psb_dpk_, &
& 1.0954676189818162_psb_dpk_, 1.1142691889576817_psb_dpk_, &
& 1.1355701829701565_psb_dpk_, 1.1595785576006521_psb_dpk_, &
& 1.1865145245551894_psb_dpk_, 1.2166114833191515_psb_dpk_, &
& 1.2501170022543431_psb_dpk_, 1.2872938516530203_psb_dpk_, &
& 1.3284210924391027_psb_dpk_, 1.3737952243949607_psb_dpk_, &
& 1.4237313979931023_psb_dpk_, 1.4785646941265451_psb_dpk_, &
& 1.5386514762605854_psb_dpk_, 0.0000000000000000_psb_dpk_, &
& 1.0000123285767939_psb_dpk_, 1.0001233683396147_psb_dpk_, &
& 1.0004322711781202_psb_dpk_, 1.0010390719329101_psb_dpk_, &
& 1.0020451337350940_psb_dpk_, 1.0035535979966428_psb_dpk_, &
& 1.0056698406248343_psb_dpk_, 1.0085019360540697_psb_dpk_, &
& 1.0121611307132341_psb_dpk_, 1.0167623275769953_psb_dpk_, &
& 1.0224245834847208_psb_dpk_, 1.0292716209515502_psb_dpk_, &
& 1.0374323562422998_psb_dpk_, 1.0470414455308106_psb_dpk_, &
& 1.0582398510249318_psb_dpk_, 1.0711754290010183_psb_dpk_, &
& 1.0860035417614331_psb_dpk_, 1.1028876956049132_psb_dpk_, &
& 1.1220002069820316_psb_dpk_, 1.1435228990979547_psb_dpk_, &
& 1.1676478313209715_psb_dpk_, 1.1945780638597872_psb_dpk_, &
& 1.2245284602839432_psb_dpk_, 1.2577265305821996_psb_dpk_, &
& 1.2944133175813315_psb_dpk_, 1.3348443296857557_psb_dpk_, &
& 1.3792905230439911_psb_dpk_, 1.4280393364047606_psb_dpk_, &
& 1.4813957820911738_psb_dpk_, 1.5396835966986973_psb_dpk_ ]
!!$ [1.1250000000000000_psb_dpk_, 0.0_psb_dpk_, 0.0_psb_dpk__psb_dpk_,,&
!!$ & 1.0238728757031315_psb_dpk_, 1.2640890537108553_psb_dpk_, 0.0_psb_dpk_,&
!!$ & 1.0084254478202830_psb_dpk_, 1.0886783920873087_psb_dpk_, 1.3375312590961856_psb_dpk_]
real(psb_dpk_), parameter :: amg_d_poly_beta_mat(30,30)=reshape(amg_d_poly_beta_vect,[30,30])
end module amg_d_poly_coeff_mod
amgprec/amg_d_poly_smoother.f90
-374
View File
@@ -1,374 +0,0 @@
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
! File: amg_d_poly_smoother_mod.f90
!
! Module: amg_d_poly_smoother_mod
!
! This module defines:
! the amg_d_poly_smoother_type data structure containing the
! smoother for a Jacobi/block Jacobi smoother.
! The smoother stores in ND the block off-diagonal matrix.
! One special case is treated separately, when the solver is DIAG or L1-DIAG
! then the ND is the entire off-diagonal part of the matrix (including the
! main diagonal block), so that it becomes possible to implement
! a pure Jacobi or L1-Jacobi global solver.
!
module amg_d_poly_smoother
use amg_d_base_smoother_mod
use amg_d_poly_coeff_mod
type, extends(amg_d_base_smoother_type) :: amg_d_poly_smoother_type
! The local solver component is inherited from the
! parent type.
! class(amg_d_base_solver_type), allocatable :: sv
!
integer(psb_ipk_) :: pdegree, variant
integer(psb_ipk_) :: rho_estimate=amg_poly_rho_est_power_
integer(psb_ipk_) :: rho_estimate_iterations=10
type(psb_dspmat_type), pointer :: pa => null()
real(psb_dpk_), allocatable :: poly_beta(:)
real(psb_dpk_) :: cf_a = dzero
real(psb_dpk_) :: rho_ba = -done
contains
procedure, pass(sm) :: apply_v => amg_d_poly_smoother_apply_vect
!!$ procedure, pass(sm) :: apply_a => amg_d_poly_smoother_apply
procedure, pass(sm) :: dump => amg_d_poly_smoother_dmp
procedure, pass(sm) :: build => amg_d_poly_smoother_bld
procedure, pass(sm) :: cnv => amg_d_poly_smoother_cnv
procedure, pass(sm) :: clone => amg_d_poly_smoother_clone
procedure, pass(sm) :: clone_settings => amg_d_poly_smoother_clone_settings
procedure, pass(sm) :: clear_data => amg_d_poly_smoother_clear_data
procedure, pass(sm) :: free => d_poly_smoother_free
procedure, pass(sm) :: cseti => amg_d_poly_smoother_cseti
procedure, pass(sm) :: csetc => amg_d_poly_smoother_csetc
procedure, pass(sm) :: csetr => amg_d_poly_smoother_csetr
procedure, pass(sm) :: descr => amg_d_poly_smoother_descr
procedure, pass(sm) :: sizeof => d_poly_smoother_sizeof
procedure, pass(sm) :: default => d_poly_smoother_default
procedure, pass(sm) :: get_nzeros => d_poly_smoother_get_nzeros
procedure, pass(sm) :: get_wrksz => d_poly_smoother_get_wrksize
procedure, nopass :: get_fmt => d_poly_smoother_get_fmt
procedure, nopass :: get_id => d_poly_smoother_get_id
end type amg_d_poly_smoother_type
private :: d_poly_smoother_free, &
& d_poly_smoother_sizeof, d_poly_smoother_get_nzeros, &
& d_poly_smoother_get_fmt, d_poly_smoother_get_id, &
& d_poly_smoother_get_wrksize
interface
subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& sweeps,work,wv,info,init,initu)
import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(amg_d_poly_smoother_type), intent(inout) :: sm
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu
end subroutine amg_d_poly_smoother_apply_vect
end interface
!!$ interface
!!$ subroutine amg_d_poly_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
!!$ & sweeps,work,info,init,initu)
!!$ import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
!!$ & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
!!$ & psb_ipk_
!!$ type(psb_desc_type), intent(in) :: desc_data
!!$ class(amg_d_poly_smoother_type), intent(inout) :: sm
!!$ real(psb_dpk_),intent(inout) :: x(:)
!!$ real(psb_dpk_),intent(inout) :: y(:)
!!$ real(psb_dpk_),intent(in) :: alpha,beta
!!$ character(len=1),intent(in) :: trans
!!$ integer(psb_ipk_), intent(in) :: sweeps
!!$ real(psb_dpk_),target, intent(inout) :: work(:)
!!$ integer(psb_ipk_), intent(out) :: info
!!$ character, intent(in), optional :: init
!!$ real(psb_dpk_),intent(inout), optional :: initu(:)
!!$ end subroutine amg_d_poly_smoother_apply
!!$ end interface
!!$
interface
subroutine amg_d_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_d_poly_smoother_bld
end interface
interface
subroutine amg_d_poly_smoother_cnv(sm,info,amold,vmold,imold)
import :: amg_d_poly_smoother_type, psb_dpk_, &
& psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
class(amg_d_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_d_poly_smoother_cnv
end interface
interface
subroutine amg_d_poly_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, &
& psb_ipk_
implicit none
class(amg_d_poly_smoother_type), intent(in) :: sm
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver, global_num
end subroutine amg_d_poly_smoother_dmp
end interface
interface
subroutine amg_d_poly_smoother_clone(sm,smout,info)
import :: amg_d_poly_smoother_type, psb_dpk_, &
& amg_d_base_smoother_type, psb_ipk_
class(amg_d_poly_smoother_type), intent(inout) :: sm
class(amg_d_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_poly_smoother_clone
end interface
interface
subroutine amg_d_poly_smoother_clone_settings(sm,smout,info)
import :: amg_d_poly_smoother_type, psb_dpk_, &
& amg_d_base_smoother_type, psb_ipk_
class(amg_d_poly_smoother_type), intent(inout) :: sm
class(amg_d_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_poly_smoother_clone_settings
end interface
interface
subroutine amg_d_poly_smoother_clear_data(sm,info)
import :: amg_d_poly_smoother_type, psb_dpk_, &
& amg_d_base_smoother_type, psb_ipk_
class(amg_d_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_poly_smoother_clear_data
end interface
interface
subroutine amg_d_poly_smoother_descr(sm,info,iout,coarse,prefix)
import :: amg_d_poly_smoother_type, psb_ipk_
class(amg_d_poly_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_d_poly_smoother_descr
end interface
interface
subroutine amg_d_poly_smoother_cseti(sm,what,val,info,idx)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
implicit none
class(amg_d_poly_smoother_type), intent(inout) :: sm
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
end subroutine amg_d_poly_smoother_cseti
end interface
interface
subroutine amg_d_poly_smoother_csetc(sm,what,val,info,idx)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
implicit none
class(amg_d_poly_smoother_type), intent(inout) :: sm
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
end subroutine amg_d_poly_smoother_csetc
end interface
interface
subroutine amg_d_poly_smoother_csetr(sm,what,val,info,idx)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
implicit none
class(amg_d_poly_smoother_type), intent(inout) :: sm
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
end subroutine amg_d_poly_smoother_csetr
end interface
contains
subroutine d_poly_smoother_free(sm,info)
Implicit None
! Arguments
class(amg_d_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_poly_smoother_free'
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
end if
if (allocated(sm%poly_beta)) deallocate(sm%poly_beta)
sm%pa => null()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_poly_smoother_free
function d_poly_smoother_sizeof(sm) result(val)
implicit none
! Arguments
class(amg_d_poly_smoother_type), intent(in) :: sm
integer(psb_epk_) :: val
val = psb_sizeof_dp
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
if (allocated(sm%poly_beta)) val = val + psb_sizeof_dp * size(sm%poly_beta)
return
end function d_poly_smoother_sizeof
subroutine d_poly_smoother_default(sm)
Implicit None
! Arguments
class(amg_d_poly_smoother_type), intent(inout) :: sm
!
! Default: BJAC with no residual check
!
sm%pdegree = 1
sm%rho_ba = -done
sm%variant = amg_cheb_4_
sm%rho_estimate = amg_poly_rho_est_power_
sm%rho_estimate_iterations = 20
if (allocated(sm%sv)) then
call sm%sv%default()
end if
return
end subroutine d_poly_smoother_default
function d_poly_smoother_get_nzeros(sm) result(val)
implicit none
! Arguments
class(amg_d_poly_smoother_type), intent(in) :: sm
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()
return
end function d_poly_smoother_get_nzeros
function d_poly_smoother_get_wrksize(sm) result(val)
implicit none
class(amg_d_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_) :: val
val = 4
if (allocated(sm%sv)) val = val + sm%sv%get_wrksz()
end function d_poly_smoother_get_wrksize
function d_poly_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Polynomial smoother"
end function d_poly_smoother_get_fmt
function d_poly_smoother_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_poly_
end function d_poly_smoother_get_id
end module amg_d_poly_smoother
amgprec/amg_d_prec_type.f90
+3 -93
View File
@@ -135,11 +135,8 @@ module amg_d_prec_type
procedure, pass(prec) :: build => amg_dprecbld
procedure, pass(prec) :: hierarchy_build => amg_d_hierarchy_bld
procedure, pass(prec) :: hierarchy_rebuild => amg_d_hierarchy_rebld
procedure, pass(prec) :: hierarchy_free => amg_d_hierarchy_free
procedure, pass(prec) :: smoothers_build => amg_d_smoothers_bld
procedure, pass(prec) :: smoothers_free => amg_d_smoothers_free
procedure, pass(prec) :: descr => amg_dfile_prec_descr
procedure, pass(prec) :: memory_use => amg_dfile_prec_memory_use
end type amg_dprec_type
private :: amg_d_dump, amg_d_get_compl, amg_d_cmp_compl,&
@@ -158,35 +155,18 @@ module amg_d_prec_type
interface amg_precdescr
subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity,prefix)
subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity)
import :: amg_dprec_type, psb_ipk_
implicit none
! Arguments
class(amg_dprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
class(amg_dprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_dfile_prec_descr
end interface
interface amg_memory_use
subroutine amg_dfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
import :: amg_dprec_type, psb_ipk_
implicit none
! Arguments
class(amg_dprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_dfile_prec_memory_use
end interface
interface amg_sizeof
module procedure amg_dprec_sizeof
end interface
@@ -364,14 +344,6 @@ module amg_d_prec_type
end subroutine amg_d_smoothers_bld
end interface amg_smoothers_bld
interface amg_smoothers_free
module procedure amg_d_smoothers_free
end interface amg_smoothers_free
interface amg_hierarchy_free
module procedure amg_d_hierarchy_free
end interface amg_hierarchy_free
contains
!
! Function returning a pointer to the smoother
@@ -645,68 +617,6 @@ contains
end subroutine amg_d_prec_free
subroutine amg_d_smoothers_free(prec,info)
implicit none
! Arguments
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
info=psb_success_
name = 'amg_d_smoothers_free'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
call prec%precv(i)%free_smoothers(info)
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_d_smoothers_free
subroutine amg_d_hierarchy_free(prec,info)
implicit none
! Arguments
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
info=psb_success_
name = 'amg_d_hierarchy_free'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
write(0,*) 'Missing implementation '
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_d_hierarchy_free
!
amgprec/amg_d_slu_solver.F90
+5 -12
View File
@@ -385,22 +385,20 @@ contains
end subroutine d_slu_solver_finalize
subroutine d_slu_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_slu_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_d_slu_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
character(len=20), parameter :: name='amg_d_slu_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -409,13 +407,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return
amgprec/amg_d_sludist_solver.F90
+8 -14
View File
@@ -270,13 +270,13 @@ contains
! Local variables
type(psb_dspmat_type) :: atmp
type(psb_d_csr_sparse_mat) :: acsr
type(psb_ctxt_type) :: ctxt
integer(psb_lpk_), allocatable :: gia(:), gja(:)
type(psb_ctxt_type) :: ctxt
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_
call psb_erractionsave(err_act)
@@ -325,6 +325,7 @@ contains
acsr%ja(:) = acsr%ja(:) - 1
acsr%irp(:) = acsr%irp(:) - 1
ifrst = lfrst - 1
info = amg_dsludist_fact(nglob,nrow_a,nztota,ifrst,&
& acsr%val,acsr%irp,acsr%ja,sv%lufactors,&
& npr,npc)
@@ -421,16 +422,15 @@ contains
end subroutine d_sludist_solver_finalize
subroutine d_sludist_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_sludist_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_d_sludist_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
@@ -438,7 +438,6 @@ contains
integer :: me, np
character(len=20), parameter :: name='amg_d_sludist_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -447,13 +446,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' SuperLU_Dist Sparse Factorization Solver. '
write(iout_,*) ' SuperLU_Dist Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return
amgprec/amg_d_symdec_aggregator_mod.f90
+4 -13
View File
@@ -88,25 +88,16 @@ contains
val = "Symmetric Decoupled aggregation"
end function amg_d_symdec_aggregator_fmt
subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_d_symdec_aggregator_type), intent(in) :: ag
type(amg_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_d_symdec_aggregator_descr
amgprec/amg_d_umf_solver.F90
+5 -12
View File
@@ -390,22 +390,20 @@ contains
end subroutine d_umf_solver_finalize
subroutine d_umf_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_umf_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_d_umf_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
character(len=20), parameter :: name='amg_d_umf_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -414,13 +412,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' UMFPACK Sparse Factorization Solver. '
write(iout_,*) ' UMFPACK Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return
amgprec/amg_s_ainv_solver.F90
+2 -13
View File
@@ -58,7 +58,6 @@ module amg_s_ainv_solver
procedure, pass(sv) :: check => amg_s_ainv_solver_check
procedure, pass(sv) :: build => amg_s_ainv_solver_bld
procedure, pass(sv) :: clone => amg_s_ainv_solver_clone
procedure, pass(sv) :: clone_settings => amg_s_ainv_solver_clone_settings
procedure, pass(sv) :: cseti => amg_s_ainv_solver_cseti
procedure, pass(sv) :: csetc => amg_s_ainv_solver_csetc
procedure, pass(sv) :: csetr => amg_s_ainv_solver_csetr
@@ -86,16 +85,6 @@ module amg_s_ainv_solver
end subroutine amg_s_ainv_solver_clone
end interface
interface
subroutine amg_s_ainv_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& amg_s_base_solver_type, psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
Implicit None
class(amg_s_ainv_solver_type), intent(inout) :: sv
class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_ainv_solver_clone_settings
end interface
interface
subroutine amg_s_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
@@ -209,7 +198,7 @@ module amg_s_ainv_solver
!!$ end interface
interface
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
Implicit None
@@ -219,7 +208,7 @@ module amg_s_ainv_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_s_ainv_solver_descr
end interface
amgprec/amg_s_as_smoother.f90
+9 -16
View File
@@ -396,23 +396,21 @@ contains
end subroutine s_as_smoother_default
subroutine s_as_smoother_descr(sm,info,iout,coarse,prefix)
subroutine s_as_smoother_descr(sm,info,iout,coarse)
Implicit None
! Arguments
class(amg_s_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_as_smoother_descr'
integer(psb_ipk_) :: iout_
logical :: coarse_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -426,21 +424,16 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (.not.coarse_) then
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
write(iout_,*) ' Additive Schwarz with ',&
& sm%novr, ' overlap layers.'
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) trim(prefix_), ' Local solver:'
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) ' Local solver:'
endif
if (allocated(sm%sv)) then
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
call sm%sv%descr(info,iout_,coarse=coarse)
end if
call psb_erractionrestore(err_act)
amgprec/amg_s_base_aggregator_mod.f90
+3 -10
View File
@@ -275,22 +275,15 @@ contains
val = .false.
end function amg_s_base_aggregator_xt_desc
subroutine amg_s_base_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_s_base_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_s_base_aggregator_type), intent(in) :: ag
type(amg_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_s_base_aggregator_descr
amgprec/amg_s_base_smoother_mod.f90
+1 -2
View File
@@ -272,7 +272,7 @@ module amg_s_base_smoother_mod
end interface
interface
subroutine amg_s_base_smoother_descr(sm,info,iout,coarse,prefix)
subroutine amg_s_base_smoother_descr(sm,info,iout,coarse)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_smoother_type, psb_ipk_
@@ -281,7 +281,6 @@ module amg_s_base_smoother_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_s_base_smoother_descr
end interface
amgprec/amg_s_base_solver_mod.f90
+2 -2
View File
@@ -270,7 +270,7 @@ module amg_s_base_solver_mod
end interface
interface
subroutine amg_s_base_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_s_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_solver_type, psb_ipk_
@@ -281,7 +281,7 @@ module amg_s_base_solver_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_s_base_solver_descr
end interface
amgprec/amg_s_dec_aggregator_mod.f90
+4 -11
View File
@@ -184,23 +184,16 @@ contains
val = "Decoupled aggregation"
end function amg_s_dec_aggregator_fmt
subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_s_dec_aggregator_type), intent(in) :: ag
type(amg_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Decoupled Aggregator'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_s_dec_aggregator_descr
amgprec/amg_s_diag_solver.f90
+6 -20
View File
@@ -219,7 +219,7 @@ contains
end subroutine s_diag_solver_free
subroutine s_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine s_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -228,13 +228,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -242,13 +240,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Diagonal local solver '
write(iout_,*) ' Diagonal local solver '
return
@@ -359,7 +352,7 @@ module amg_s_l1_diag_solver
contains
subroutine s_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine s_l1_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -368,13 +361,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_l1_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -382,13 +373,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
write(iout_,*) ' L1 Diagonal solver '
return
amgprec/amg_s_gs_solver.f90
+12 -26
View File
@@ -433,22 +433,20 @@ contains
return
end subroutine s_gs_solver_free
subroutine s_gs_solver_descr(sv,info,iout,coarse,prefix)
subroutine s_gs_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_s_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_gs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -457,17 +455,12 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
@@ -533,22 +526,20 @@ contains
val = .true.
end function s_gs_solver_is_iterative
subroutine s_bwgs_solver_descr(sv,info,iout,coarse,prefix)
subroutine s_bwgs_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_s_bwgs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_bwgs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -557,17 +548,12 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
amgprec/amg_s_id_solver.f90
+3 -10
View File
@@ -157,7 +157,7 @@ contains
return
end subroutine s_id_solver_free
subroutine s_id_solver_descr(sv,info,iout,coarse,prefix)
subroutine s_id_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -165,14 +165,12 @@ contains
class(amg_s_id_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_id_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -180,13 +178,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Identity local solver '
write(iout_,*) ' Identity local solver '
return
amgprec/amg_s_ilu_solver.f90
+14 -21
View File
@@ -234,7 +234,7 @@ contains
! Arguments
class(amg_s_ilu_solver_type), intent(inout) :: sv
sv%fact_type = amg_ilu_n_
sv%fact_type = psb_ilu_n_
sv%fill_in = 0
sv%thresh = szero
@@ -255,13 +255,13 @@ contains
info = psb_success_
call amg_check_def(sv%fact_type,&
& 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
& 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
select case(sv%fact_type)
case(amg_ilu_n_,amg_milu_n_)
case(psb_ilu_n_,psb_milu_n_)
call amg_check_def(sv%fill_in,&
& 'Level',izero,is_int_non_negative)
case(amg_ilu_t_)
case(psb_ilu_t_)
call amg_check_def(sv%thresh,&
& 'Eps',szero,is_legal_s_fact_thrs)
end select
@@ -406,7 +406,7 @@ contains
return
end subroutine s_ilu_solver_free
subroutine s_ilu_solver_descr(sv,info,iout,coarse,prefix)
subroutine s_ilu_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -414,14 +414,12 @@ contains
class(amg_s_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_ilu_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -430,20 +428,15 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
write(iout_,*) ' Incomplete factorization solver: ',&
& amg_fact_names(sv%fact_type)
select case(sv%fact_type)
case(amg_ilu_n_,amg_milu_n_)
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
case(amg_ilu_t_)
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
case(psb_ilu_n_,psb_milu_n_)
write(iout_,*) ' Fill level:',sv%fill_in
case(psb_ilu_t_)
write(iout_,*) ' Fill level:',sv%fill_in
write(iout_,*) ' Fill threshold :',sv%thresh
end select
call psb_erractionrestore(err_act)
@@ -496,7 +489,7 @@ contains
implicit none
integer(psb_ipk_) :: val
val = amg_ilu_n_
val = psb_ilu_n_
end function s_ilu_solver_get_id
function s_ilu_solver_get_wrksize() result(val)
amgprec/amg_s_invk_solver.f90
+2 -14
View File
@@ -52,7 +52,6 @@ module amg_s_invk_solver
contains
procedure, pass(sv) :: check => amg_s_invk_solver_check
procedure, pass(sv) :: clone => amg_s_invk_solver_clone
procedure, pass(sv) :: clone_settings => amg_s_invk_solver_clone_settings
procedure, pass(sv) :: build => amg_s_invk_solver_bld
procedure, pass(sv) :: cseti => amg_s_invk_solver_cseti
procedure, pass(sv) :: descr => amg_s_invk_solver_descr
@@ -74,17 +73,6 @@ module amg_s_invk_solver
end subroutine amg_s_invk_solver_clone
end interface
interface
subroutine amg_s_invk_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& amg_s_base_solver_type, psb_spk_, amg_s_invk_solver_type, psb_ipk_
Implicit None
class(amg_s_invk_solver_type), intent(inout) :: sv
class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_invk_solver_clone_settings
end interface
interface
subroutine amg_s_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
@@ -135,7 +123,7 @@ module amg_s_invk_solver
end interface
interface
subroutine amg_s_invk_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_s_invk_solver_descr(sv,info,iout,coarse)
import :: psb_spk_, amg_s_invk_solver_type, psb_ipk_
Implicit None
@@ -145,7 +133,7 @@ module amg_s_invk_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_s_invk_solver_descr
end interface
amgprec/amg_s_invt_solver.f90
+4 -17
View File
@@ -52,7 +52,6 @@ module amg_s_invt_solver
contains
procedure, pass(sv) :: check => amg_s_invt_solver_check
procedure, pass(sv) :: clone => amg_s_invt_solver_clone
procedure, pass(sv) :: clone_settings => amg_s_invt_solver_clone_settings
procedure, pass(sv) :: build => amg_s_invt_solver_bld
procedure, pass(sv) :: cseti => amg_s_invt_solver_cseti
procedure, pass(sv) :: csetr => amg_s_invt_solver_csetr
@@ -74,17 +73,6 @@ module amg_s_invt_solver
end subroutine amg_s_invt_solver_clone
end interface
interface
subroutine amg_s_invt_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& amg_s_base_solver_type, psb_spk_, amg_s_invt_solver_type, psb_ipk_
Implicit None
class(amg_s_invt_solver_type), intent(inout) :: sv
class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_invt_solver_clone_settings
end interface
interface
subroutine amg_s_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
@@ -146,17 +134,16 @@ module amg_s_invt_solver
end interface
interface
subroutine amg_s_invt_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_s_invt_solver_descr(sv,info,iout,coarse)
import :: psb_spk_, amg_s_invt_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_s_invt_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine amg_s_invt_solver_descr
end interface
amgprec/amg_s_jac_smoother.f90
+6 -8
View File
@@ -219,13 +219,12 @@ module amg_s_jac_smoother
end interface
interface
subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse,prefix)
subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse)
import :: amg_s_jac_smoother_type, psb_ipk_
class(amg_s_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
end subroutine amg_s_jac_smoother_descr
end interface
@@ -314,13 +313,12 @@ module amg_s_jac_smoother
end interface
interface
subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse)
import :: amg_s_l1_jac_smoother_type, psb_ipk_
class(amg_s_l1_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine amg_s_l1_jac_smoother_descr
end interface
amgprec/amg_s_jac_solver.f90
-585
View File
@@ -1,585 +0,0 @@
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
! File: amg_s_jac_solver_mod.f90
!
! Module: amg_s_jac_solver_mod
!
! This module defines:
! - the amg_s_jac_solver_type data structure containing the ingredients
! for a local Jacobi iteration. The iterations are local to a process
! (they operate on the block diagonal).
!
!
module amg_s_jac_solver
use amg_s_base_solver_mod
type, extends(amg_s_base_solver_type) :: amg_s_jac_solver_type
type(psb_sspmat_type) :: a
type(psb_s_vect_type), allocatable :: dv
real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_) :: sweeps
real(psb_spk_) :: eps
contains
procedure, pass(sv) :: dump => amg_s_jac_solver_dmp
procedure, pass(sv) :: check => s_jac_solver_check
procedure, pass(sv) :: clone => amg_s_jac_solver_clone
procedure, pass(sv) :: clone_settings => amg_s_jac_solver_clone_settings
procedure, pass(sv) :: clear_data => amg_s_jac_solver_clear_data
procedure, pass(sv) :: build => amg_s_jac_solver_bld
procedure, pass(sv) :: cnv => amg_s_jac_solver_cnv
procedure, pass(sv) :: apply_v => amg_s_jac_solver_apply_vect
procedure, pass(sv) :: apply_a => amg_s_jac_solver_apply
procedure, pass(sv) :: free => s_jac_solver_free
procedure, pass(sv) :: cseti => s_jac_solver_cseti
procedure, pass(sv) :: csetc => s_jac_solver_csetc
procedure, pass(sv) :: csetr => s_jac_solver_csetr
procedure, pass(sv) :: descr => s_jac_solver_descr
procedure, pass(sv) :: default => s_jac_solver_default
procedure, pass(sv) :: sizeof => s_jac_solver_sizeof
procedure, pass(sv) :: get_nzeros => s_jac_solver_get_nzeros
procedure, nopass :: get_wrksz => s_jac_solver_get_wrksize
procedure, nopass :: get_fmt => s_jac_solver_get_fmt
procedure, nopass :: get_id => s_jac_solver_get_id
procedure, nopass :: is_iterative => s_jac_solver_is_iterative
end type amg_s_jac_solver_type
type, extends(amg_s_jac_solver_type) :: amg_s_l1_jac_solver_type
contains
procedure, pass(sv) :: build => amg_s_l1_jac_solver_bld
procedure, pass(sv) :: descr => s_l1_jac_solver_descr
procedure, nopass :: get_fmt => s_l1_jac_solver_get_fmt
procedure, nopass :: get_id => s_l1_jac_solver_get_id
end type amg_s_l1_jac_solver_type
private :: s_jac_solver_bld, s_jac_solver_apply, &
& s_jac_solver_free, &
& s_jac_solver_descr, s_jac_solver_sizeof, &
& s_jac_solver_default, s_jac_solver_dmp, &
& s_jac_solver_apply_vect, s_jac_solver_get_nzeros, &
& s_jac_solver_get_fmt, s_jac_solver_check,&
& s_jac_solver_is_iterative, &
& s_jac_solver_get_id, s_jac_solver_get_wrksize
interface
subroutine amg_s_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,wv,info,init,initu)
import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_s_jac_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu
end subroutine amg_s_jac_solver_apply_vect
end interface
interface
subroutine amg_s_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_s_jac_solver_type), intent(inout) :: sv
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
real(psb_spk_),intent(inout), optional :: initu(:)
end subroutine amg_s_jac_solver_apply
end interface
interface
subroutine amg_s_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_s_jac_solver_bld
end interface
interface
subroutine amg_s_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_s_l1_jac_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_s_l1_jac_solver_bld
end interface
interface
subroutine amg_s_jac_solver_cnv(sv,info,amold,vmold,imold)
import :: amg_s_jac_solver_type, psb_spk_, &
& psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
class(amg_s_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_s_jac_solver_cnv
end interface
interface
subroutine amg_s_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
& psb_ipk_
implicit none
class(amg_s_jac_solver_type), intent(in) :: sv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver, global_num
end subroutine amg_s_jac_solver_dmp
end interface
interface
subroutine amg_s_jac_solver_clone(sv,svout,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_solver_type, amg_s_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_jac_solver_clone
end interface
!!$ interface
!!$ subroutine amg_s_l1_jac_solver_clone(sv,svout,info)
!!$ import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
!!$ & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
!!$ & amg_s_base_solver_type, amg_s_l1_jac_solver_type, psb_ipk_
!!$ Implicit None
!!$
!!$ ! Arguments
!!$ class(amg_s_l1_jac_solver_type), intent(inout) :: sv
!!$ class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_s_l1_jac_solver_clone
!!$ end interface
interface
subroutine amg_s_jac_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_solver_type, amg_s_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
class(amg_s_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_jac_solver_clone_settings
end interface
interface
subroutine amg_s_jac_solver_clear_data(sv,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_jac_solver_clear_data
end interface
contains
subroutine s_jac_solver_default(sv)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
sv%sweeps = ione
sv%eps = dzero
return
end subroutine s_jac_solver_default
subroutine s_jac_solver_check(sv,info)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_jac_solver_check'
call psb_erractionsave(err_act)
info = psb_success_
call amg_check_def(sv%sweeps,&
& 'Jacobi sweeps',ione,is_int_positive)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_jac_solver_check
subroutine s_jac_solver_cseti(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_jac_solver_cseti'
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(what))
case('SOLVER_SWEEPS')
sv%sweeps = val
case default
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_jac_solver_cseti
subroutine s_jac_solver_csetc(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='s_jac_solver_csetc'
info = psb_success_
call psb_erractionsave(err_act)
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info, name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_jac_solver_csetc
subroutine s_jac_solver_csetr(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_jac_solver_csetr'
call psb_erractionsave(err_act)
info = psb_success_
select case(psb_toupper(what))
case('SOLVER_EPS')
sv%eps = val
case default
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_jac_solver_csetr
subroutine s_jac_solver_free(sv,info)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_jac_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
call sv%a%free()
if (allocated(sv%dv)) then
call sv%dv%free(info)
deallocate(sv%dv)
end if
if (allocated(sv%d)) deallocate(sv%d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_jac_solver_free
subroutine s_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_jac_solver_descr
function s_jac_solver_get_nzeros(sv) result(val)
implicit none
! Arguments
class(amg_s_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = 0
val = val + sv%a%get_nzeros()
val = val + sv%dv%get_nrows()
return
end function s_jac_solver_get_nzeros
function s_jac_solver_sizeof(sv) result(val)
implicit none
! Arguments
class(amg_s_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = psb_sizeof_ip
val = val + sv%a%sizeof()
val = val + sv%dv%sizeof()
return
end function s_jac_solver_sizeof
function s_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Jacobi solver"
end function s_jac_solver_get_fmt
function s_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_jac_
end function s_jac_solver_get_id
!
! If this is true, then the solver needs a starting
! guess. Currently only handled in JAC smoother.
!
function s_jac_solver_is_iterative() result(val)
implicit none
logical :: val
val = .true.
end function s_jac_solver_is_iterative
function s_jac_solver_get_wrksize() result(val)
implicit none
integer(psb_ipk_) :: val
val = 2
end function s_jac_solver_get_wrksize
subroutine s_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_s_l1_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_l1_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_l1_jac_solver_descr
function s_l1_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "L1-Jacobi solver"
end function s_l1_jac_solver_get_fmt
function s_l1_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_l1_jac_
end function s_l1_jac_solver_get_id
end module amg_s_jac_solver
amgprec/amg_s_krm_solver.f90
+15 -16
View File
@@ -436,7 +436,7 @@ contains
val = "KRM solver"
end function s_krm_solver_get_fmt
subroutine s_krm_solver_descr(sv,info,iout,coarse,prefix)
subroutine s_krm_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -444,14 +444,12 @@ contains
class(amg_s_krm_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_krm_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -460,22 +458,23 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%global) then
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
write(iout_,*) ' Krylov solver (global)'
else
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
write(iout_,*) ' Krylov solver (local) '
end if
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
write(iout_,*) ' method: ',sv%method
write(iout_,*) ' kprec: ',sv%kprec
if (sv%i_sub_solve > 0) then
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
else
write(iout_,*) ' sub_solve: ',sv%sub_solve
end if
write(iout_,*) ' itmax: ',sv%itmax
write(iout_,*) ' eps: ',sv%eps
write(iout_,*) ' fillin: ',sv%fillin
call psb_erractionrestore(err_act)
return
amgprec/amg_s_matchboxp_mod.f90
+13 -41
View File
@@ -143,10 +143,9 @@ contains
type(psb_ls_coo_sparse_mat) :: tmpcoo
logical :: display_out_, print_out_, reproducible_
logical, parameter :: dump=.false., debug=.false., dump_mate=.false., &
& debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
& debug_ilaggr=.false., debug_sync=.false.
integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
logical, parameter :: do_timings=.true.
integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
ictxt = desc_a%get_ctxt()
call psb_info(ictxt,iam,np)
@@ -188,7 +187,7 @@ contains
call desc_a%l2gip(ilv,info,owned=.false.)
call psb_geall(ilaggr,desc_a,info)
ilaggr = ilaggr_neginit
ilaggr = -1
call psb_geasb(ilaggr,desc_a,info)
nr = a%get_nrows()
nc = a%get_ncols()
@@ -214,20 +213,7 @@ contains
call psb_barrier(ictxt)
if (iam == 0) write(0,*)' out from buildmatching:', info
end if
if (debug_mate) then
block
integer(psb_lpk_), allocatable :: ckmate(:)
allocate(ckmate(nr))
ckmate(1:nr) = mate(1:nr)
call psb_msort(ckmate(1:nr))
do i=1,nr-1
if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
write(0,*) iam,' Duplicate mate entry at',i,' :',ckmate(i)
end if
end do
end block
end if
if (info == 0) then
if (do_timings) call psb_tic(idx_phase2)
if (debug_sync) then
@@ -273,7 +259,7 @@ contains
cycle
else
if (ilaggr(k) == ilaggr_neginit) then
if (ilaggr(k) == -1) then
wk = w(k)
widx = w(idx)
@@ -281,7 +267,7 @@ contains
nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
if (nrmagg > epsilon(nrmagg)) then
if (idx <= nr) then
if (ilaggr(idx) == ilaggr_neginit) then
if (ilaggr(idx) == -1) then
! Now, if both vertices are local, the aggregate is local
! (kinda obvious).
nlaggr(iam) = nlaggr(iam) + 1
@@ -289,9 +275,6 @@ contains
ilaggr(idx) = nlaggr(iam)
wtemp(k) = w(k)/nrmagg
wtemp(idx) = w(idx)/nrmagg
else
write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
&mate(idx),ilaggr(idx)
end if
nlpairs = nlpairs+1
else if (idx <= nc) then
@@ -311,7 +294,7 @@ contains
ilaggr(k) = nlaggr(iam)
nlpairs = nlpairs+1
else
ilaggr(k) = ilaggr_nonlocal
ilaggr(k) = -2
end if
else
! Use a statistically unbiased tie-breaking rule,
@@ -326,7 +309,7 @@ contains
ilaggr(k) = nlaggr(iam)
nlpairs = nlpairs+1
else
ilaggr(k) = ilaggr_nonlocal
ilaggr(k) = -2
end if
end if
end if
@@ -342,12 +325,6 @@ contains
nlsingl = nlsingl + 1
end if
end if
if (ilaggr(k) == ilaggr_neginit) then
write(0,*) iam,' Error: no update to ',k,mate(k),&
& abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
end if
else
if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
end if
end if
end do
@@ -355,7 +332,7 @@ contains
if (do_timings) call psb_tic(idx_phase3)
! Ok, now compute offsets, gather halo and fix non-local
! aggregates (those where ilaggr == ilaggr_nonlocal)
! aggregates (those where ilaggr == -2)
call psb_sum(ictxt,nlaggr)
ntaggr = sum(nlaggr(0:np-1))
naggrm1 = sum(nlaggr(0:iam-1))
@@ -370,7 +347,7 @@ contains
call psb_halo(wtemp,desc_a,info)
! Cleanup as yet unmarked entries
do k=1,nr
if (ilaggr(k) == ilaggr_nonlocal) then
if (ilaggr(k) == -2) then
idx = mate(k)
if (idx > nr) then
i = ilaggr(idx)
@@ -382,14 +359,9 @@ contains
else
write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
end if
else if (ilaggr(k) <0) then
write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
write(0,*) iam,' : : ',nr,nc,mate(k)
if (mate(k) <= nr) then
write(0,*) iam,' : : ',ilaggr(mate(k)),mate(mate(k)),&
& ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
end if
flush(0)
end if
if (ilaggr(k) <0) then
write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
end if
end do
if (debug_sync) then
@@ -442,7 +414,7 @@ contains
end block
if (iam == 0) then
write(0,*) iam,'Matching statistics: Unmatched nodes ',&
write(0,*) 'Matching statistics: Unmatched nodes ',&
& nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
end if
amgprec/amg_s_mumps_solver.F90
+7 -15
View File
@@ -78,8 +78,7 @@ module amg_s_mumps_solver
!
! Controls to be set before MUMPS instantiation:
!
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: 'LOCAL_SOLVER
! 1==amg_global_solver_: 'GLOBAL_SOLVER'
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: LOCAL 1==amg_global_solver_: GLOBAL
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
integer(psb_ipk_), dimension(3) :: ipar
@@ -314,24 +313,22 @@ subroutine s_mumps_solver_finalize(sv)
end subroutine s_mumps_solver_finalize
subroutine s_mumps_solver_descr(sv,info,iout,coarse,prefix)
subroutine s_mumps_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_s_mumps_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -340,13 +337,8 @@ subroutine s_mumps_solver_descr(sv,info,iout,coarse,prefix)
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
write(iout_,*) ' MUMPS Solver. '
call psb_erractionrestore(err_act)
return
amgprec/amg_s_onelev_mod.f90
+2 -34
View File
@@ -188,10 +188,8 @@ module amg_s_onelev_mod
procedure, pass(lv) :: clone => s_base_onelev_clone
procedure, pass(lv) :: cnv => amg_s_base_onelev_cnv
procedure, pass(lv) :: descr => amg_s_base_onelev_descr
procedure, pass(lv) :: memory_use => amg_s_base_onelev_memory_use
procedure, pass(lv) :: default => s_base_onelev_default
procedure, pass(lv) :: free => amg_s_base_onelev_free
procedure, pass(lv) :: free_smoothers => amg_s_base_onelev_free_smoothers
procedure, pass(lv) :: nullify => s_base_onelev_nullify
procedure, pass(lv) :: check => amg_s_base_onelev_check
procedure, pass(lv) :: dump => amg_s_base_onelev_dump
@@ -260,7 +258,7 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@@ -271,27 +269,9 @@ module amg_s_onelev_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_s_base_onelev_descr
end interface
interface
subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_s_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_s_base_onelev_memory_use
end interface
interface
subroutine amg_s_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_s_onelev_type, psb_s_base_vect_type, psb_spk_, &
@@ -305,7 +285,7 @@ module amg_s_onelev_mod
end subroutine amg_s_base_onelev_cnv
end interface
interface
interface
subroutine amg_s_base_onelev_free(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
@@ -317,18 +297,6 @@ module amg_s_onelev_mod
end subroutine amg_s_base_onelev_free
end interface
interface
subroutine amg_s_base_onelev_free_smoothers(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none
class(amg_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_base_onelev_free_smoothers
end interface
interface
subroutine amg_s_base_onelev_check(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
amgprec/amg_s_parmatch_aggregator_mod.F90
+6 -13
View File
@@ -390,25 +390,18 @@ contains
end function amg_s_parmatch_aggregator_sizeof
subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_s_parmatch_aggregator_type), intent(in) :: ag
type(amg_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps
write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Parallel Matching Aggregator'
write(iout,*) ' Number of matching sweeps: ',ag%n_sweeps
write(iout,*) ' Matching algorithm : MatchBoxP (PREIS)'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_s_parmatch_aggregator_descr
amgprec/amg_s_poly_smoother.f90
-374
View File
@@ -1,374 +0,0 @@
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Daniela di Serafino
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
! File: amg_s_poly_smoother_mod.f90
!
! Module: amg_s_poly_smoother_mod
!
! This module defines:
! the amg_s_poly_smoother_type data structure containing the
! smoother for a Jacobi/block Jacobi smoother.
! The smoother stores in ND the block off-diagonal matrix.
! One special case is treated separately, when the solver is DIAG or L1-DIAG
! then the ND is the entire off-diagonal part of the matrix (including the
! main diagonal block), so that it becomes possible to implement
! a pure Jacobi or L1-Jacobi global solver.
!
module amg_s_poly_smoother
use amg_s_base_smoother_mod
use amg_d_poly_coeff_mod
type, extends(amg_s_base_smoother_type) :: amg_s_poly_smoother_type
! The local solver component is inherited from the
! parent type.
! class(amg_s_base_solver_type), allocatable :: sv
!
integer(psb_ipk_) :: pdegree, variant
integer(psb_ipk_) :: rho_estimate=amg_poly_rho_est_power_
integer(psb_ipk_) :: rho_estimate_iterations=10
type(psb_sspmat_type), pointer :: pa => null()
real(psb_spk_), allocatable :: poly_beta(:)
real(psb_spk_) :: cf_a = szero
real(psb_spk_) :: rho_ba = -sone
contains
procedure, pass(sm) :: apply_v => amg_s_poly_smoother_apply_vect
!!$ procedure, pass(sm) :: apply_a => amg_s_poly_smoother_apply
procedure, pass(sm) :: dump => amg_s_poly_smoother_dmp
procedure, pass(sm) :: build => amg_s_poly_smoother_bld
procedure, pass(sm) :: cnv => amg_s_poly_smoother_cnv
procedure, pass(sm) :: clone => amg_s_poly_smoother_clone
procedure, pass(sm) :: clone_settings => amg_s_poly_smoother_clone_settings
procedure, pass(sm) :: clear_data => amg_s_poly_smoother_clear_data
procedure, pass(sm) :: free => s_poly_smoother_free
procedure, pass(sm) :: cseti => amg_s_poly_smoother_cseti
procedure, pass(sm) :: csetc => amg_s_poly_smoother_csetc
procedure, pass(sm) :: csetr => amg_s_poly_smoother_csetr
procedure, pass(sm) :: descr => amg_s_poly_smoother_descr
procedure, pass(sm) :: sizeof => s_poly_smoother_sizeof
procedure, pass(sm) :: default => s_poly_smoother_default
procedure, pass(sm) :: get_nzeros => s_poly_smoother_get_nzeros
procedure, pass(sm) :: get_wrksz => s_poly_smoother_get_wrksize
procedure, nopass :: get_fmt => s_poly_smoother_get_fmt
procedure, nopass :: get_id => s_poly_smoother_get_id
end type amg_s_poly_smoother_type
private :: s_poly_smoother_free, &
& s_poly_smoother_sizeof, s_poly_smoother_get_nzeros, &
& s_poly_smoother_get_fmt, s_poly_smoother_get_id, &
& s_poly_smoother_get_wrksize
interface
subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& sweeps,work,wv,info,init,initu)
import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_
type(psb_desc_type), intent(in) :: desc_data
class(amg_s_poly_smoother_type), intent(inout) :: sm
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu
end subroutine amg_s_poly_smoother_apply_vect
end interface
!!$ interface
!!$ subroutine amg_s_poly_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
!!$ & sweeps,work,info,init,initu)
!!$ import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
!!$ & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
!!$ & psb_ipk_
!!$ type(psb_desc_type), intent(in) :: desc_data
!!$ class(amg_s_poly_smoother_type), intent(inout) :: sm
!!$ real(psb_spk_),intent(inout) :: x(:)
!!$ real(psb_spk_),intent(inout) :: y(:)
!!$ real(psb_spk_),intent(in) :: alpha,beta
!!$ character(len=1),intent(in) :: trans
!!$ integer(psb_ipk_), intent(in) :: sweeps
!!$ real(psb_spk_),target, intent(inout) :: work(:)
!!$ integer(psb_ipk_), intent(out) :: info
!!$ character, intent(in), optional :: init
!!$ real(psb_spk_),intent(inout), optional :: initu(:)
!!$ end subroutine amg_s_poly_smoother_apply
!!$ end interface
!!$
interface
subroutine amg_s_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_s_poly_smoother_bld
end interface
interface
subroutine amg_s_poly_smoother_cnv(sm,info,amold,vmold,imold)
import :: amg_s_poly_smoother_type, psb_spk_, &
& psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
class(amg_s_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_s_poly_smoother_cnv
end interface
interface
subroutine amg_s_poly_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, &
& psb_ipk_
implicit none
class(amg_s_poly_smoother_type), intent(in) :: sm
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver, global_num
end subroutine amg_s_poly_smoother_dmp
end interface
interface
subroutine amg_s_poly_smoother_clone(sm,smout,info)
import :: amg_s_poly_smoother_type, psb_spk_, &
& amg_s_base_smoother_type, psb_ipk_
class(amg_s_poly_smoother_type), intent(inout) :: sm
class(amg_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_poly_smoother_clone
end interface
interface
subroutine amg_s_poly_smoother_clone_settings(sm,smout,info)
import :: amg_s_poly_smoother_type, psb_spk_, &
& amg_s_base_smoother_type, psb_ipk_
class(amg_s_poly_smoother_type), intent(inout) :: sm
class(amg_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_poly_smoother_clone_settings
end interface
interface
subroutine amg_s_poly_smoother_clear_data(sm,info)
import :: amg_s_poly_smoother_type, psb_spk_, &
& amg_s_base_smoother_type, psb_ipk_
class(amg_s_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_poly_smoother_clear_data
end interface
interface
subroutine amg_s_poly_smoother_descr(sm,info,iout,coarse,prefix)
import :: amg_s_poly_smoother_type, psb_ipk_
class(amg_s_poly_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_s_poly_smoother_descr
end interface
interface
subroutine amg_s_poly_smoother_cseti(sm,what,val,info,idx)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
implicit none
class(amg_s_poly_smoother_type), intent(inout) :: sm
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
end subroutine amg_s_poly_smoother_cseti
end interface
interface
subroutine amg_s_poly_smoother_csetc(sm,what,val,info,idx)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
implicit none
class(amg_s_poly_smoother_type), intent(inout) :: sm
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
end subroutine amg_s_poly_smoother_csetc
end interface
interface
subroutine amg_s_poly_smoother_csetr(sm,what,val,info,idx)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
implicit none
class(amg_s_poly_smoother_type), intent(inout) :: sm
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
end subroutine amg_s_poly_smoother_csetr
end interface
contains
subroutine s_poly_smoother_free(sm,info)
Implicit None
! Arguments
class(amg_s_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_poly_smoother_free'
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(sm%sv)) then
call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
end if
if (allocated(sm%poly_beta)) deallocate(sm%poly_beta)
sm%pa => null()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_poly_smoother_free
function s_poly_smoother_sizeof(sm) result(val)
implicit none
! Arguments
class(amg_s_poly_smoother_type), intent(in) :: sm
integer(psb_epk_) :: val
val = psb_sizeof_dp
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
if (allocated(sm%poly_beta)) val = val + psb_sizeof_dp * size(sm%poly_beta)
return
end function s_poly_smoother_sizeof
subroutine s_poly_smoother_default(sm)
Implicit None
! Arguments
class(amg_s_poly_smoother_type), intent(inout) :: sm
!
! Default: BJAC with no residual check
!
sm%pdegree = 1
sm%rho_ba = -sone
sm%variant = amg_cheb_4_
sm%rho_estimate = amg_poly_rho_est_power_
sm%rho_estimate_iterations = 20
if (allocated(sm%sv)) then
call sm%sv%default()
end if
return
end subroutine s_poly_smoother_default
function s_poly_smoother_get_nzeros(sm) result(val)
implicit none
! Arguments
class(amg_s_poly_smoother_type), intent(in) :: sm
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = 0
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()
return
end function s_poly_smoother_get_nzeros
function s_poly_smoother_get_wrksize(sm) result(val)
implicit none
class(amg_s_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_) :: val
val = 4
if (allocated(sm%sv)) val = val + sm%sv%get_wrksz()
end function s_poly_smoother_get_wrksize
function s_poly_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Polynomial smoother"
end function s_poly_smoother_get_fmt
function s_poly_smoother_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_poly_
end function s_poly_smoother_get_id
end module amg_s_poly_smoother
amgprec/amg_s_prec_type.f90
+3 -93
View File
@@ -135,11 +135,8 @@ module amg_s_prec_type
procedure, pass(prec) :: build => amg_sprecbld
procedure, pass(prec) :: hierarchy_build => amg_s_hierarchy_bld
procedure, pass(prec) :: hierarchy_rebuild => amg_s_hierarchy_rebld
procedure, pass(prec) :: hierarchy_free => amg_s_hierarchy_free
procedure, pass(prec) :: smoothers_build => amg_s_smoothers_bld
procedure, pass(prec) :: smoothers_free => amg_s_smoothers_free
procedure, pass(prec) :: descr => amg_sfile_prec_descr
procedure, pass(prec) :: memory_use => amg_sfile_prec_memory_use
end type amg_sprec_type
private :: amg_s_dump, amg_s_get_compl, amg_s_cmp_compl,&
@@ -158,35 +155,18 @@ module amg_s_prec_type
interface amg_precdescr
subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity,prefix)
subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity)
import :: amg_sprec_type, psb_ipk_
implicit none
! Arguments
class(amg_sprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
class(amg_sprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_sfile_prec_descr
end interface
interface amg_memory_use
subroutine amg_sfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
import :: amg_sprec_type, psb_ipk_
implicit none
! Arguments
class(amg_sprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_sfile_prec_memory_use
end interface
interface amg_sizeof
module procedure amg_sprec_sizeof
end interface
@@ -364,14 +344,6 @@ module amg_s_prec_type
end subroutine amg_s_smoothers_bld
end interface amg_smoothers_bld
interface amg_smoothers_free
module procedure amg_s_smoothers_free
end interface amg_smoothers_free
interface amg_hierarchy_free
module procedure amg_s_hierarchy_free
end interface amg_hierarchy_free
contains
!
! Function returning a pointer to the smoother
@@ -645,68 +617,6 @@ contains
end subroutine amg_s_prec_free
subroutine amg_s_smoothers_free(prec,info)
implicit none
! Arguments
class(amg_sprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
info=psb_success_
name = 'amg_s_smoothers_free'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
call prec%precv(i)%free_smoothers(info)
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_s_smoothers_free
subroutine amg_s_hierarchy_free(prec,info)
implicit none
! Arguments
class(amg_sprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
info=psb_success_
name = 'amg_s_hierarchy_free'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
write(0,*) 'Missing implementation '
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_s_hierarchy_free
!
amgprec/amg_s_slu_solver.F90
+5 -12
View File
@@ -385,22 +385,20 @@ contains
end subroutine s_slu_solver_finalize
subroutine s_slu_solver_descr(sv,info,iout,coarse,prefix)
subroutine s_slu_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_s_slu_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
character(len=20), parameter :: name='amg_s_slu_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -409,13 +407,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return
amgprec/amg_s_symdec_aggregator_mod.f90
+4 -13
View File
@@ -88,25 +88,16 @@ contains
val = "Symmetric Decoupled aggregation"
end function amg_s_symdec_aggregator_fmt
subroutine amg_s_symdec_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_s_symdec_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_s_symdec_aggregator_type), intent(in) :: ag
type(amg_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_s_symdec_aggregator_descr
amgprec/amg_z_ainv_solver.F90
+2 -13
View File
@@ -58,7 +58,6 @@ module amg_z_ainv_solver
procedure, pass(sv) :: check => amg_z_ainv_solver_check
procedure, pass(sv) :: build => amg_z_ainv_solver_bld
procedure, pass(sv) :: clone => amg_z_ainv_solver_clone
procedure, pass(sv) :: clone_settings => amg_z_ainv_solver_clone_settings
procedure, pass(sv) :: cseti => amg_z_ainv_solver_cseti
procedure, pass(sv) :: csetc => amg_z_ainv_solver_csetc
procedure, pass(sv) :: csetr => amg_z_ainv_solver_csetr
@@ -86,16 +85,6 @@ module amg_z_ainv_solver
end subroutine amg_z_ainv_solver_clone
end interface
interface
subroutine amg_z_ainv_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& amg_z_base_solver_type, psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
Implicit None
class(amg_z_ainv_solver_type), intent(inout) :: sv
class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_z_ainv_solver_clone_settings
end interface
interface
subroutine amg_z_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
@@ -209,7 +198,7 @@ module amg_z_ainv_solver
!!$ end interface
interface
subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
Implicit None
@@ -219,7 +208,7 @@ module amg_z_ainv_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_z_ainv_solver_descr
end interface
amgprec/amg_z_as_smoother.f90
+9 -16
View File
@@ -396,23 +396,21 @@ contains
end subroutine z_as_smoother_default
subroutine z_as_smoother_descr(sm,info,iout,coarse,prefix)
subroutine z_as_smoother_descr(sm,info,iout,coarse)
Implicit None
! Arguments
class(amg_z_as_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_z_as_smoother_descr'
integer(psb_ipk_) :: iout_
logical :: coarse_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -426,21 +424,16 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (.not.coarse_) then
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
write(iout_,*) ' Additive Schwarz with ',&
& sm%novr, ' overlap layers.'
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) trim(prefix_), ' Local solver:'
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) ' Local solver:'
endif
if (allocated(sm%sv)) then
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
call sm%sv%descr(info,iout_,coarse=coarse)
end if
call psb_erractionrestore(err_act)
amgprec/amg_z_base_aggregator_mod.f90
+3 -10
View File
@@ -275,22 +275,15 @@ contains
val = .false.
end function amg_z_base_aggregator_xt_desc
subroutine amg_z_base_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_z_base_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_z_base_aggregator_type), intent(in) :: ag
type(amg_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_z_base_aggregator_descr
amgprec/amg_z_base_smoother_mod.f90
+1 -2
View File
@@ -272,7 +272,7 @@ module amg_z_base_smoother_mod
end interface
interface
subroutine amg_z_base_smoother_descr(sm,info,iout,coarse,prefix)
subroutine amg_z_base_smoother_descr(sm,info,iout,coarse)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& amg_z_base_smoother_type, psb_ipk_
@@ -281,7 +281,6 @@ module amg_z_base_smoother_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_z_base_smoother_descr
end interface
amgprec/amg_z_base_solver_mod.f90
+2 -2
View File
@@ -270,7 +270,7 @@ module amg_z_base_solver_mod
end interface
interface
subroutine amg_z_base_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_z_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& amg_z_base_solver_type, psb_ipk_
@@ -281,7 +281,7 @@ module amg_z_base_solver_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_z_base_solver_descr
end interface
amgprec/amg_z_dec_aggregator_mod.f90
+4 -11
View File
@@ -184,23 +184,16 @@ contains
val = "Decoupled aggregation"
end function amg_z_dec_aggregator_fmt
subroutine amg_z_dec_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_z_dec_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_z_dec_aggregator_type), intent(in) :: ag
type(amg_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Decoupled Aggregator'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_z_dec_aggregator_descr
amgprec/amg_z_diag_solver.f90
+6 -20
View File
@@ -219,7 +219,7 @@ contains
end subroutine z_diag_solver_free
subroutine z_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine z_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -228,13 +228,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_z_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -242,13 +240,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Diagonal local solver '
write(iout_,*) ' Diagonal local solver '
return
@@ -359,7 +352,7 @@ module amg_z_l1_diag_solver
contains
subroutine z_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine z_l1_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -368,13 +361,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_z_l1_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -382,13 +373,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
write(iout_,*) ' L1 Diagonal solver '
return
amgprec/amg_z_gs_solver.f90
+12 -26
View File
@@ -433,22 +433,20 @@ contains
return
end subroutine z_gs_solver_free
subroutine z_gs_solver_descr(sv,info,iout,coarse,prefix)
subroutine z_gs_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_z_gs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_z_gs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -457,17 +455,12 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
@@ -533,22 +526,20 @@ contains
val = .true.
end function z_gs_solver_is_iterative
subroutine z_bwgs_solver_descr(sv,info,iout,coarse,prefix)
subroutine z_bwgs_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_z_bwgs_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_z_bwgs_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -557,17 +548,12 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
amgprec/amg_z_id_solver.f90
+3 -10
View File
@@ -157,7 +157,7 @@ contains
return
end subroutine z_id_solver_free
subroutine z_id_solver_descr(sv,info,iout,coarse,prefix)
subroutine z_id_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -165,14 +165,12 @@ contains
class(amg_z_id_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_z_id_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -180,13 +178,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Identity local solver '
write(iout_,*) ' Identity local solver '
return
amgprec/amg_z_ilu_solver.f90
+14 -21
View File
@@ -234,7 +234,7 @@ contains
! Arguments
class(amg_z_ilu_solver_type), intent(inout) :: sv
sv%fact_type = amg_ilu_n_
sv%fact_type = psb_ilu_n_
sv%fill_in = 0
sv%thresh = dzero
@@ -255,13 +255,13 @@ contains
info = psb_success_
call amg_check_def(sv%fact_type,&
& 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
& 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
select case(sv%fact_type)
case(amg_ilu_n_,amg_milu_n_)
case(psb_ilu_n_,psb_milu_n_)
call amg_check_def(sv%fill_in,&
& 'Level',izero,is_int_non_negative)
case(amg_ilu_t_)
case(psb_ilu_t_)
call amg_check_def(sv%thresh,&
& 'Eps',dzero,is_legal_d_fact_thrs)
end select
@@ -406,7 +406,7 @@ contains
return
end subroutine z_ilu_solver_free
subroutine z_ilu_solver_descr(sv,info,iout,coarse,prefix)
subroutine z_ilu_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -414,14 +414,12 @@ contains
class(amg_z_ilu_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_z_ilu_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -430,20 +428,15 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
write(iout_,*) ' Incomplete factorization solver: ',&
& amg_fact_names(sv%fact_type)
select case(sv%fact_type)
case(amg_ilu_n_,amg_milu_n_)
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
case(amg_ilu_t_)
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
case(psb_ilu_n_,psb_milu_n_)
write(iout_,*) ' Fill level:',sv%fill_in
case(psb_ilu_t_)
write(iout_,*) ' Fill level:',sv%fill_in
write(iout_,*) ' Fill threshold :',sv%thresh
end select
call psb_erractionrestore(err_act)
@@ -496,7 +489,7 @@ contains
implicit none
integer(psb_ipk_) :: val
val = amg_ilu_n_
val = psb_ilu_n_
end function z_ilu_solver_get_id
function z_ilu_solver_get_wrksize() result(val)
amgprec/amg_z_invk_solver.f90
+2 -14
View File
@@ -52,7 +52,6 @@ module amg_z_invk_solver
contains
procedure, pass(sv) :: check => amg_z_invk_solver_check
procedure, pass(sv) :: clone => amg_z_invk_solver_clone
procedure, pass(sv) :: clone_settings => amg_z_invk_solver_clone_settings
procedure, pass(sv) :: build => amg_z_invk_solver_bld
procedure, pass(sv) :: cseti => amg_z_invk_solver_cseti
procedure, pass(sv) :: descr => amg_z_invk_solver_descr
@@ -74,17 +73,6 @@ module amg_z_invk_solver
end subroutine amg_z_invk_solver_clone
end interface
interface
subroutine amg_z_invk_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& amg_z_base_solver_type, psb_dpk_, amg_z_invk_solver_type, psb_ipk_
Implicit None
class(amg_z_invk_solver_type), intent(inout) :: sv
class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_z_invk_solver_clone_settings
end interface
interface
subroutine amg_z_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
@@ -135,7 +123,7 @@ module amg_z_invk_solver
end interface
interface
subroutine amg_z_invk_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_z_invk_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_z_invk_solver_type, psb_ipk_
Implicit None
@@ -145,7 +133,7 @@ module amg_z_invk_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_z_invk_solver_descr
end interface
amgprec/amg_z_invt_solver.f90
+4 -17
View File
@@ -52,7 +52,6 @@ module amg_z_invt_solver
contains
procedure, pass(sv) :: check => amg_z_invt_solver_check
procedure, pass(sv) :: clone => amg_z_invt_solver_clone
procedure, pass(sv) :: clone_settings => amg_z_invt_solver_clone_settings
procedure, pass(sv) :: build => amg_z_invt_solver_bld
procedure, pass(sv) :: cseti => amg_z_invt_solver_cseti
procedure, pass(sv) :: csetr => amg_z_invt_solver_csetr
@@ -74,17 +73,6 @@ module amg_z_invt_solver
end subroutine amg_z_invt_solver_clone
end interface
interface
subroutine amg_z_invt_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& amg_z_base_solver_type, psb_dpk_, amg_z_invt_solver_type, psb_ipk_
Implicit None
class(amg_z_invt_solver_type), intent(inout) :: sv
class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_z_invt_solver_clone_settings
end interface
interface
subroutine amg_z_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
@@ -146,17 +134,16 @@ module amg_z_invt_solver
end interface
interface
subroutine amg_z_invt_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_z_invt_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_z_invt_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_z_invt_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine amg_z_invt_solver_descr
end interface
amgprec/amg_z_jac_smoother.f90
+6 -8
View File
@@ -219,13 +219,12 @@ module amg_z_jac_smoother
end interface
interface
subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse,prefix)
subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse)
import :: amg_z_jac_smoother_type, psb_ipk_
class(amg_z_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
end subroutine amg_z_jac_smoother_descr
end interface
@@ -314,13 +313,12 @@ module amg_z_jac_smoother
end interface
interface
subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse)
import :: amg_z_l1_jac_smoother_type, psb_ipk_
class(amg_z_l1_jac_smoother_type), intent(in) :: sm
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine amg_z_l1_jac_smoother_descr
end interface
amgprec/amg_z_jac_solver.f90
-585
View File
@@ -1,585 +0,0 @@
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2021
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
! File: amg_z_jac_solver_mod.f90
!
! Module: amg_z_jac_solver_mod
!
! This module defines:
! - the amg_z_jac_solver_type data structure containing the ingredients
! for a local Jacobi iteration. The iterations are local to a process
! (they operate on the block diagonal).
!
!
module amg_z_jac_solver
use amg_z_base_solver_mod
type, extends(amg_z_base_solver_type) :: amg_z_jac_solver_type
type(psb_zspmat_type) :: a
type(psb_z_vect_type), allocatable :: dv
complex(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_) :: sweeps
real(psb_dpk_) :: eps
contains
procedure, pass(sv) :: dump => amg_z_jac_solver_dmp
procedure, pass(sv) :: check => z_jac_solver_check
procedure, pass(sv) :: clone => amg_z_jac_solver_clone
procedure, pass(sv) :: clone_settings => amg_z_jac_solver_clone_settings
procedure, pass(sv) :: clear_data => amg_z_jac_solver_clear_data
procedure, pass(sv) :: build => amg_z_jac_solver_bld
procedure, pass(sv) :: cnv => amg_z_jac_solver_cnv
procedure, pass(sv) :: apply_v => amg_z_jac_solver_apply_vect
procedure, pass(sv) :: apply_a => amg_z_jac_solver_apply
procedure, pass(sv) :: free => z_jac_solver_free
procedure, pass(sv) :: cseti => z_jac_solver_cseti
procedure, pass(sv) :: csetc => z_jac_solver_csetc
procedure, pass(sv) :: csetr => z_jac_solver_csetr
procedure, pass(sv) :: descr => z_jac_solver_descr
procedure, pass(sv) :: default => z_jac_solver_default
procedure, pass(sv) :: sizeof => z_jac_solver_sizeof
procedure, pass(sv) :: get_nzeros => z_jac_solver_get_nzeros
procedure, nopass :: get_wrksz => z_jac_solver_get_wrksize
procedure, nopass :: get_fmt => z_jac_solver_get_fmt
procedure, nopass :: get_id => z_jac_solver_get_id
procedure, nopass :: is_iterative => z_jac_solver_is_iterative
end type amg_z_jac_solver_type
type, extends(amg_z_jac_solver_type) :: amg_z_l1_jac_solver_type
contains
procedure, pass(sv) :: build => amg_z_l1_jac_solver_bld
procedure, pass(sv) :: descr => z_l1_jac_solver_descr
procedure, nopass :: get_fmt => z_l1_jac_solver_get_fmt
procedure, nopass :: get_id => z_l1_jac_solver_get_id
end type amg_z_l1_jac_solver_type
private :: z_jac_solver_bld, z_jac_solver_apply, &
& z_jac_solver_free, &
& z_jac_solver_descr, z_jac_solver_sizeof, &
& z_jac_solver_default, z_jac_solver_dmp, &
& z_jac_solver_apply_vect, z_jac_solver_get_nzeros, &
& z_jac_solver_get_fmt, z_jac_solver_check,&
& z_jac_solver_is_iterative, &
& z_jac_solver_get_id, z_jac_solver_get_wrksize
interface
subroutine amg_z_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,wv,info,init,initu)
import :: psb_desc_type, amg_z_jac_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_z_jac_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu
end subroutine amg_z_jac_solver_apply_vect
end interface
interface
subroutine amg_z_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
import :: psb_desc_type, amg_z_jac_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_z_jac_solver_type), intent(inout) :: sv
complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
complex(psb_dpk_),intent(inout), optional :: initu(:)
end subroutine amg_z_jac_solver_apply
end interface
interface
subroutine amg_z_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_z_jac_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_z_jac_solver_bld
end interface
interface
subroutine amg_z_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_z_l1_jac_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_z_l1_jac_solver_bld
end interface
interface
subroutine amg_z_jac_solver_cnv(sv,info,amold,vmold,imold)
import :: amg_z_jac_solver_type, psb_dpk_, &
& psb_z_base_sparse_mat, psb_z_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
class(amg_z_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_z_jac_solver_cnv
end interface
interface
subroutine amg_z_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, amg_z_jac_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, &
& psb_ipk_
implicit none
class(amg_z_jac_solver_type), intent(in) :: sv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver, global_num
end subroutine amg_z_jac_solver_dmp
end interface
interface
subroutine amg_z_jac_solver_clone(sv,svout,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& amg_z_base_solver_type, amg_z_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_z_jac_solver_type), intent(inout) :: sv
class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_z_jac_solver_clone
end interface
!!$ interface
!!$ subroutine amg_z_l1_jac_solver_clone(sv,svout,info)
!!$ import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
!!$ & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
!!$ & amg_z_base_solver_type, amg_z_l1_jac_solver_type, psb_ipk_
!!$ Implicit None
!!$
!!$ ! Arguments
!!$ class(amg_z_l1_jac_solver_type), intent(inout) :: sv
!!$ class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_z_l1_jac_solver_clone
!!$ end interface
interface
subroutine amg_z_jac_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& amg_z_base_solver_type, amg_z_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_z_jac_solver_type), intent(inout) :: sv
class(amg_z_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_z_jac_solver_clone_settings
end interface
interface
subroutine amg_z_jac_solver_clear_data(sv,info)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& amg_z_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_z_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_z_jac_solver_clear_data
end interface
contains
subroutine z_jac_solver_default(sv)
Implicit None
! Arguments
class(amg_z_jac_solver_type), intent(inout) :: sv
sv%sweeps = ione
sv%eps = dzero
return
end subroutine z_jac_solver_default
subroutine z_jac_solver_check(sv,info)
Implicit None
! Arguments
class(amg_z_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_jac_solver_check'
call psb_erractionsave(err_act)
info = psb_success_
call amg_check_def(sv%sweeps,&
& 'Jacobi sweeps',ione,is_int_positive)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine z_jac_solver_check
subroutine z_jac_solver_cseti(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_z_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_jac_solver_cseti'
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(what))
case('SOLVER_SWEEPS')
sv%sweeps = val
case default
call sv%amg_z_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine z_jac_solver_cseti
subroutine z_jac_solver_csetc(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_z_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='z_jac_solver_csetc'
info = psb_success_
call psb_erractionsave(err_act)
call sv%amg_z_base_solver_type%set(what,val,info,idx=idx)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info, name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine z_jac_solver_csetc
subroutine z_jac_solver_csetr(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_z_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_jac_solver_csetr'
call psb_erractionsave(err_act)
info = psb_success_
select case(psb_toupper(what))
case('SOLVER_EPS')
sv%eps = val
case default
call sv%amg_z_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine z_jac_solver_csetr
subroutine z_jac_solver_free(sv,info)
Implicit None
! Arguments
class(amg_z_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_jac_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
call sv%a%free()
if (allocated(sv%dv)) then
call sv%dv%free(info)
deallocate(sv%dv)
end if
if (allocated(sv%d)) deallocate(sv%d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine z_jac_solver_free
subroutine z_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_z_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_z_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine z_jac_solver_descr
function z_jac_solver_get_nzeros(sv) result(val)
implicit none
! Arguments
class(amg_z_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = 0
val = val + sv%a%get_nzeros()
val = val + sv%dv%get_nrows()
return
end function z_jac_solver_get_nzeros
function z_jac_solver_sizeof(sv) result(val)
implicit none
! Arguments
class(amg_z_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = psb_sizeof_ip
val = val + sv%a%sizeof()
val = val + sv%dv%sizeof()
return
end function z_jac_solver_sizeof
function z_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Jacobi solver"
end function z_jac_solver_get_fmt
function z_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_jac_
end function z_jac_solver_get_id
!
! If this is true, then the solver needs a starting
! guess. Currently only handled in JAC smoother.
!
function z_jac_solver_is_iterative() result(val)
implicit none
logical :: val
val = .true.
end function z_jac_solver_is_iterative
function z_jac_solver_get_wrksize() result(val)
implicit none
integer(psb_ipk_) :: val
val = 2
end function z_jac_solver_get_wrksize
subroutine z_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_z_l1_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_z_l1_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine z_l1_jac_solver_descr
function z_l1_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "L1-Jacobi solver"
end function z_l1_jac_solver_get_fmt
function z_l1_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_l1_jac_
end function z_l1_jac_solver_get_id
end module amg_z_jac_solver
amgprec/amg_z_krm_solver.f90
+15 -16
View File
@@ -436,7 +436,7 @@ contains
val = "KRM solver"
end function z_krm_solver_get_fmt
subroutine z_krm_solver_descr(sv,info,iout,coarse,prefix)
subroutine z_krm_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -444,14 +444,12 @@ contains
class(amg_z_krm_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_z_krm_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -460,22 +458,23 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%global) then
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
write(iout_,*) ' Krylov solver (global)'
else
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
write(iout_,*) ' Krylov solver (local) '
end if
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
write(iout_,*) ' method: ',sv%method
write(iout_,*) ' kprec: ',sv%kprec
if (sv%i_sub_solve > 0) then
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
else
write(iout_,*) ' sub_solve: ',sv%sub_solve
end if
write(iout_,*) ' itmax: ',sv%itmax
write(iout_,*) ' eps: ',sv%eps
write(iout_,*) ' fillin: ',sv%fillin
call psb_erractionrestore(err_act)
return
amgprec/amg_z_mumps_solver.F90
+7 -15
View File
@@ -78,8 +78,7 @@ module amg_z_mumps_solver
!
! Controls to be set before MUMPS instantiation:
!
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: 'LOCAL_SOLVER
! 1==amg_global_solver_: 'GLOBAL_SOLVER'
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: LOCAL 1==amg_global_solver_: GLOBAL
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
integer(psb_ipk_), dimension(3) :: ipar
@@ -314,24 +313,22 @@ subroutine z_mumps_solver_finalize(sv)
end subroutine z_mumps_solver_finalize
subroutine z_mumps_solver_descr(sv,info,iout,coarse,prefix)
subroutine z_mumps_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_z_mumps_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -340,13 +337,8 @@ subroutine z_mumps_solver_descr(sv,info,iout,coarse,prefix)
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
write(iout_,*) ' MUMPS Solver. '
call psb_erractionrestore(err_act)
return
amgprec/amg_z_onelev_mod.f90
+2 -34
View File
@@ -187,10 +187,8 @@ module amg_z_onelev_mod
procedure, pass(lv) :: clone => z_base_onelev_clone
procedure, pass(lv) :: cnv => amg_z_base_onelev_cnv
procedure, pass(lv) :: descr => amg_z_base_onelev_descr
procedure, pass(lv) :: memory_use => amg_z_base_onelev_memory_use
procedure, pass(lv) :: default => z_base_onelev_default
procedure, pass(lv) :: free => amg_z_base_onelev_free
procedure, pass(lv) :: free_smoothers => amg_z_base_onelev_free_smoothers
procedure, pass(lv) :: nullify => z_base_onelev_nullify
procedure, pass(lv) :: check => amg_z_base_onelev_check
procedure, pass(lv) :: dump => amg_z_base_onelev_dump
@@ -259,7 +257,7 @@ module amg_z_onelev_mod
end interface
interface
subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@@ -270,27 +268,9 @@ module amg_z_onelev_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_z_base_onelev_descr
end interface
interface
subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_z_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_z_base_onelev_memory_use
end interface
interface
subroutine amg_z_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_z_onelev_type, psb_z_base_vect_type, psb_dpk_, &
@@ -304,7 +284,7 @@ module amg_z_onelev_mod
end subroutine amg_z_base_onelev_cnv
end interface
interface
interface
subroutine amg_z_base_onelev_free(lv,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
@@ -316,18 +296,6 @@ module amg_z_onelev_mod
end subroutine amg_z_base_onelev_free
end interface
interface
subroutine amg_z_base_onelev_free_smoothers(lv,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none
class(amg_z_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_z_base_onelev_free_smoothers
end interface
interface
subroutine amg_z_base_onelev_check(lv,info)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
amgprec/amg_z_prec_type.f90
+3 -93
View File
@@ -135,11 +135,8 @@ module amg_z_prec_type
procedure, pass(prec) :: build => amg_zprecbld
procedure, pass(prec) :: hierarchy_build => amg_z_hierarchy_bld
procedure, pass(prec) :: hierarchy_rebuild => amg_z_hierarchy_rebld
procedure, pass(prec) :: hierarchy_free => amg_z_hierarchy_free
procedure, pass(prec) :: smoothers_build => amg_z_smoothers_bld
procedure, pass(prec) :: smoothers_free => amg_z_smoothers_free
procedure, pass(prec) :: descr => amg_zfile_prec_descr
procedure, pass(prec) :: memory_use => amg_zfile_prec_memory_use
end type amg_zprec_type
private :: amg_z_dump, amg_z_get_compl, amg_z_cmp_compl,&
@@ -158,35 +155,18 @@ module amg_z_prec_type
interface amg_precdescr
subroutine amg_zfile_prec_descr(prec,info,iout,root,verbosity,prefix)
subroutine amg_zfile_prec_descr(prec,info,iout,root,verbosity)
import :: amg_zprec_type, psb_ipk_
implicit none
! Arguments
class(amg_zprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
class(amg_zprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_zfile_prec_descr
end interface
interface amg_memory_use
subroutine amg_zfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
import :: amg_zprec_type, psb_ipk_
implicit none
! Arguments
class(amg_zprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_zfile_prec_memory_use
end interface
interface amg_sizeof
module procedure amg_zprec_sizeof
end interface
@@ -364,14 +344,6 @@ module amg_z_prec_type
end subroutine amg_z_smoothers_bld
end interface amg_smoothers_bld
interface amg_smoothers_free
module procedure amg_z_smoothers_free
end interface amg_smoothers_free
interface amg_hierarchy_free
module procedure amg_z_hierarchy_free
end interface amg_hierarchy_free
contains
!
! Function returning a pointer to the smoother
@@ -645,68 +617,6 @@ contains
end subroutine amg_z_prec_free
subroutine amg_z_smoothers_free(prec,info)
implicit none
! Arguments
class(amg_zprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
info=psb_success_
name = 'amg_z_smoothers_free'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
call prec%precv(i)%free_smoothers(info)
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_z_smoothers_free
subroutine amg_z_hierarchy_free(prec,info)
implicit none
! Arguments
class(amg_zprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
info=psb_success_
name = 'amg_z_hierarchy_free'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
write(0,*) 'Missing implementation '
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_z_hierarchy_free
!
amgprec/amg_z_slu_solver.F90
+5 -12
View File
@@ -385,22 +385,20 @@ contains
end subroutine z_slu_solver_finalize
subroutine z_slu_solver_descr(sv,info,iout,coarse,prefix)
subroutine z_slu_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_z_slu_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
character(len=20), parameter :: name='amg_z_slu_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -409,13 +407,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return
amgprec/amg_z_sludist_solver.F90
+8 -15
View File
@@ -270,13 +270,13 @@ contains
! Local variables
type(psb_zspmat_type) :: atmp
type(psb_z_csr_sparse_mat) :: acsr
type(psb_ctxt_type) :: ctxt
integer(psb_lpk_), allocatable :: gia(:), gja(:)
type(psb_ctxt_type) :: ctxt
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_
call psb_erractionsave(err_act)
@@ -324,7 +324,7 @@ contains
acsr%ja(1:nztota) = gja(1:nztota)
acsr%ja(:) = acsr%ja(:) - 1
acsr%irp(:) = acsr%irp(:) - 1
ifrst = lfrst - 1
ifrst = lfrst - 1
info = amg_zsludist_fact(nglob,nrow_a,nztota,ifrst,&
& acsr%val,acsr%irp,acsr%ja,sv%lufactors,&
& npr,npc)
@@ -421,16 +421,15 @@ contains
end subroutine z_sludist_solver_finalize
subroutine z_sludist_solver_descr(sv,info,iout,coarse,prefix)
subroutine z_sludist_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_z_sludist_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
@@ -438,7 +437,6 @@ contains
integer :: me, np
character(len=20), parameter :: name='amg_z_sludist_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -447,13 +445,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' SuperLU_Dist Sparse Factorization Solver. '
write(iout_,*) ' SuperLU_Dist Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return
amgprec/amg_z_symdec_aggregator_mod.f90
+4 -13
View File
@@ -88,25 +88,16 @@ contains
val = "Symmetric Decoupled aggregation"
end function amg_z_symdec_aggregator_fmt
subroutine amg_z_symdec_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_z_symdec_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_z_symdec_aggregator_type), intent(in) :: ag
type(amg_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_z_symdec_aggregator_descr
amgprec/amg_z_umf_solver.F90
+5 -12
View File
@@ -390,22 +390,20 @@ contains
end subroutine z_umf_solver_finalize
subroutine z_umf_solver_descr(sv,info,iout,coarse,prefix)
subroutine z_umf_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_z_umf_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
character(len=20), parameter :: name='amg_z_umf_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -414,13 +412,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' UMFPACK Sparse Factorization Solver. '
write(iout_,*) ' UMFPACK Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return

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