mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-07 07:04:59 +00:00
Compare commits
3
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
 Salvatore Filippone
|
bbed340405 | ||
|
Salvatore Filippone
|
51a9d16975 | ||
|
Salvatore Filippone
|
a04f7b4cf0 |
+3
-3
@@ -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
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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,14 +41,14 @@ cleanlib:
|
||||
(cd modules; /bin/rm -f *.a *$(.mod) *$(.fh))
|
||||
|
||||
veryclean: cleanlib
|
||||
(cd amgprec && $(MAKE) veryclean)
|
||||
(cd samples/simple/fileread && $(MAKE) clean)
|
||||
(cd samples/simple/pdegen && $(MAKE) clean)
|
||||
(cd samples/advanced/fileread && $(MAKE) clean)
|
||||
(cd samples/advanced/pdegen && $(MAKE) clean)
|
||||
(cd amgprec; make veryclean)
|
||||
(cd samples/simple/fileread; make clean)
|
||||
(cd samples/simple/pdegen; make clean)
|
||||
(cd samples/advanced/fileread; make clean)
|
||||
(cd samples/advanced/pdegen; make clean)
|
||||
|
||||
check: all
|
||||
make check -C samples/advanced/pdegen
|
||||
|
||||
clean:
|
||||
(cd amgprec && $(MAKE) clean)
|
||||
(cd amgprec; make clean)
|
||||
|
||||
@@ -1,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)
|
||||
|
||||
+14
-17
@@ -11,7 +11,7 @@ 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_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 \
|
||||
@@ -22,7 +22,7 @@ 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_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 \
|
||||
@@ -33,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 \
|
||||
@@ -43,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 \
|
||||
@@ -62,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)
|
||||
@@ -155,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
|
||||
@@ -166,7 +163,7 @@ amg_dprecinit.o amg_dprecset.o: amg_d_diag_solver.o amg_d_ilu_solver.o \
|
||||
amg_d_id_solver.o amg_d_slu_solver.o amg_d_sludist_solver.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
|
||||
@@ -176,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
|
||||
@@ -186,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
|
||||
@@ -221,4 +218,4 @@ clean: implclean
|
||||
/bin/rm -f $(OBJS) $(LOCAL_MODS) *$(.mod)
|
||||
|
||||
implclean:
|
||||
cd impl && $(MAKE) clean
|
||||
$(MAKE) -C impl clean
|
||||
|
||||
+56
-139
@@ -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
|
||||
@@ -578,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
|
||||
@@ -677,52 +649,43 @@ contains
|
||||
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
|
||||
|
||||
@@ -730,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_
|
||||
@@ -750,7 +712,7 @@ contains
|
||||
end if
|
||||
|
||||
if (coarse_) then
|
||||
call pm%coarsedescr(iout,info,prefix=prefix)
|
||||
call pm%coarsedescr(iout,info)
|
||||
end if
|
||||
|
||||
return
|
||||
@@ -758,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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
+12
-26
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -189,7 +189,6 @@ module amg_c_onelev_mod
|
||||
procedure, pass(lv) :: descr => amg_c_base_onelev_descr
|
||||
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
|
||||
@@ -258,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
|
||||
@@ -269,7 +268,6 @@ 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
|
||||
|
||||
@@ -286,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, &
|
||||
@@ -298,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, &
|
||||
|
||||
@@ -135,9 +135,7 @@ 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
|
||||
end type amg_cprec_type
|
||||
|
||||
@@ -157,16 +155,15 @@ 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
|
||||
|
||||
@@ -347,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
|
||||
@@ -628,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
|
||||
|
||||
|
||||
!
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
+12
-26
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -190,7 +190,6 @@ module amg_d_onelev_mod
|
||||
procedure, pass(lv) :: descr => amg_d_base_onelev_descr
|
||||
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
|
||||
@@ -259,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
|
||||
@@ -270,7 +269,6 @@ 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
|
||||
|
||||
@@ -287,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, &
|
||||
@@ -299,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, &
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -135,9 +135,7 @@ 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
|
||||
end type amg_dprec_type
|
||||
|
||||
@@ -157,16 +155,15 @@ 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
|
||||
|
||||
@@ -347,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
|
||||
@@ -628,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
|
||||
|
||||
|
||||
!
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
+12
-26
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -190,7 +190,6 @@ module amg_s_onelev_mod
|
||||
procedure, pass(lv) :: descr => amg_s_base_onelev_descr
|
||||
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
|
||||
@@ -259,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
|
||||
@@ -270,7 +269,6 @@ 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
|
||||
|
||||
@@ -287,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, &
|
||||
@@ -299,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, &
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -135,9 +135,7 @@ 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
|
||||
end type amg_sprec_type
|
||||
|
||||
@@ -157,16 +155,15 @@ 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
|
||||
|
||||
@@ -347,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
|
||||
@@ -628,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
|
||||
|
||||
|
||||
!
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
+12
-26
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -189,7 +189,6 @@ module amg_z_onelev_mod
|
||||
procedure, pass(lv) :: descr => amg_z_base_onelev_descr
|
||||
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
|
||||
@@ -258,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
|
||||
@@ -269,7 +268,6 @@ 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
|
||||
|
||||
@@ -286,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, &
|
||||
@@ -298,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, &
|
||||
|
||||
@@ -135,9 +135,7 @@ 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
|
||||
end type amg_zprec_type
|
||||
|
||||
@@ -157,16 +155,15 @@ 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
|
||||
|
||||
@@ -347,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
|
||||
@@ -628,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
|
||||
|
||||
|
||||
!
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
+11
-14
@@ -67,25 +67,22 @@ OBJS=$(F90OBJS) $(COBJS) $(MPCOBJS)
|
||||
|
||||
LIBNAME=libamg_prec.a
|
||||
|
||||
objs: $(OBJS) aggrd levd smoothd solvd
|
||||
|
||||
lib: $(OBJS) aggrd levd smoothd solvd
|
||||
cd aggregator && $(MAKE) lib
|
||||
cd level && $(MAKE) lib
|
||||
cd smoother && $(MAKE) lib
|
||||
cd solver && $(MAKE) lib
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
|
||||
aggrd:
|
||||
cd aggregator && $(MAKE) objs
|
||||
$(MAKE) -C aggregator
|
||||
levd:
|
||||
cd level && $(MAKE) objs
|
||||
$(MAKE) -C level
|
||||
smoothd:
|
||||
cd smoother && $(MAKE) objs
|
||||
$(MAKE) -C smoother
|
||||
solvd:
|
||||
cd solver && $(MAKE) objs
|
||||
$(MAKE) -C solver
|
||||
|
||||
mpobjs:
|
||||
(make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)")
|
||||
(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
|
||||
|
||||
veryclean: clean
|
||||
/bin/rm -f $(LIBNAME)
|
||||
@@ -94,10 +91,10 @@ clean: solvclean smoothclean levclean aggrclean
|
||||
/bin/rm -f $(OBJS) $(LOCAL_MODS)
|
||||
|
||||
aggrclean:
|
||||
cd aggregator && $(MAKE) clean
|
||||
$(MAKE) -C aggregator clean
|
||||
levclean:
|
||||
cd level && $(MAKE) clean
|
||||
$(MAKE) -C level clean
|
||||
smoothclean:
|
||||
cd smoother && $(MAKE) clean
|
||||
$(MAKE) -C smoother clean
|
||||
solvclean:
|
||||
cd solver && $(MAKE) clean
|
||||
$(MAKE) -C solver clean
|
||||
|
||||
@@ -62,30 +62,13 @@ amg_s_parmatch_smth_bld.o \
|
||||
amg_s_parmatch_spmm_bld_inner.o
|
||||
|
||||
MPCOBJS=MatchBoxPC.o \
|
||||
sendBundledMessages.o \
|
||||
initialize.o \
|
||||
extractUChunk.o \
|
||||
isAlreadyMatched.o \
|
||||
findOwnerOfGhost.o \
|
||||
clean.o \
|
||||
computeCandidateMate.o \
|
||||
parallelComputeCandidateMateB.o \
|
||||
processMatchedVertices.o \
|
||||
processMatchedVerticesAndSendMessages.o \
|
||||
processCrossEdge.o \
|
||||
queueTransfer.o \
|
||||
processMessages.o \
|
||||
processExposedVertex.o \
|
||||
algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o \
|
||||
algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.o
|
||||
algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o
|
||||
|
||||
OBJS = $(FOBJS) $(MPCOBJS)
|
||||
|
||||
LIBNAME=libamg_prec.a
|
||||
|
||||
objs: $(OBJS)
|
||||
|
||||
lib: objs
|
||||
lib: $(OBJS)
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
|
||||
|
||||
@@ -42,6 +42,7 @@
|
||||
#include <stdlib.h>
|
||||
#if !defined(SERIAL_MPI)
|
||||
#include <mpi.h>
|
||||
#endif
|
||||
|
||||
#include "MatchBoxPC.h"
|
||||
#ifdef __cplusplus
|
||||
@@ -59,43 +60,17 @@ void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
|
||||
#if !defined(SERIAL_MPI)
|
||||
MPI_Comm C_comm=MPI_Comm_f2c(icomm);
|
||||
|
||||
#ifdef DEBUG
|
||||
fprintf(stderr,"MatchBoxPC: rank %d nlver %ld nledge %ld [ %ld %ld ]\n",
|
||||
myRank,NLVer, NLEdge,verDistance[0],verDistance[1]);
|
||||
#endif
|
||||
|
||||
|
||||
#define TIME_TRACKER
|
||||
#ifdef TIME_TRACKER
|
||||
double tmr = MPI_Wtime();
|
||||
#endif
|
||||
|
||||
#define OMP
|
||||
#ifdef OMP
|
||||
dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(NLVer, NLEdge,
|
||||
dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(NLVer, NLEdge,
|
||||
verLocPtr, verLocInd, edgeLocWeight,
|
||||
verDistance, Mate,
|
||||
myRank, numProcs, C_comm,
|
||||
msgIndSent, msgActualSent, msgPercent,
|
||||
ph0_time, ph1_time, ph2_time,
|
||||
ph1_card, ph2_card );
|
||||
#else
|
||||
dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(NLVer, NLEdge,
|
||||
verLocPtr, verLocInd, edgeLocWeight,
|
||||
verDistance, Mate,
|
||||
myRank, numProcs, C_comm,
|
||||
msgIndSent, msgActualSent, msgPercent,
|
||||
ph0_time, ph1_time, ph2_time,
|
||||
ph1_card, ph2_card );
|
||||
#endif
|
||||
|
||||
|
||||
#ifdef TIME_TRACKER
|
||||
tmr = MPI_Wtime() - tmr;
|
||||
fprintf(stderr, "Elaboration time: %f for %ld nodes\n", tmr, NLVer);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -126,4 +101,3 @@ void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
@@ -52,415 +52,145 @@
|
||||
|
||||
#ifndef _matchboxpC_H_
|
||||
#define _matchboxpC_H_
|
||||
// Turn on a lot of debugging information with this switch:
|
||||
//Turn on a lot of debugging information with this switch:
|
||||
//#define PRINT_DEBUG_INFO_
|
||||
#include <stdio.h>
|
||||
#include <iostream>
|
||||
#include <assert.h>
|
||||
#include <map>
|
||||
#include <vector>
|
||||
#include "omp.h"
|
||||
// #include "matchboxp.h"
|
||||
#include "primitiveDataTypeDefinitions.h"
|
||||
#include "dataStrStaticQueue.h"
|
||||
|
||||
using namespace std;
|
||||
|
||||
const int NUM_THREAD = 4;
|
||||
const int UCHUNK = 10;
|
||||
|
||||
const MilanLongInt REQUEST = 1;
|
||||
const MilanLongInt SUCCESS = 2;
|
||||
const MilanLongInt FAILURE = 3;
|
||||
const MilanLongInt SIZEINFO = 4;
|
||||
|
||||
const int ComputeTag = 7; // Predefined tag
|
||||
const int BundleTag = 9; // Predefined tag
|
||||
|
||||
static vector<MilanLongInt> DEFAULT_VECTOR;
|
||||
|
||||
#if !defined(SERIAL_MPI)
|
||||
|
||||
// MPI type map
|
||||
template <typename T>
|
||||
MPI_Datatype TypeMap();
|
||||
template <>
|
||||
inline MPI_Datatype TypeMap<int64_t>() { return MPI_LONG_LONG; }
|
||||
template <>
|
||||
inline MPI_Datatype TypeMap<int>() { return MPI_INT; }
|
||||
template <>
|
||||
inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
|
||||
template <>
|
||||
inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
{
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
#if !defined(SERIAL_MPI)
|
||||
|
||||
#define MilanMpiLongInt MPI_LONG_LONG
|
||||
|
||||
#define MilanMpiLongInt MPI_LONG_LONG
|
||||
|
||||
#ifndef _primitiveDataType_Definition_
|
||||
#define _primitiveDataType_Definition_
|
||||
// Regular integer:
|
||||
#ifndef INTEGER_H
|
||||
#define INTEGER_H
|
||||
typedef int32_t MilanInt;
|
||||
#endif
|
||||
//Regular integer:
|
||||
#ifndef INTEGER_H
|
||||
#define INTEGER_H
|
||||
typedef int32_t MilanInt;
|
||||
#endif
|
||||
|
||||
// Regular long integer:
|
||||
#ifndef LONG_INT_H
|
||||
#define LONG_INT_H
|
||||
#ifdef BIT64
|
||||
typedef int64_t MilanLongInt;
|
||||
typedef MPI_LONG MilanMpiLongInt;
|
||||
#else
|
||||
typedef int32_t MilanLongInt;
|
||||
typedef MPI_INT MilanMpiLongInt;
|
||||
#endif
|
||||
#endif
|
||||
//Regular long integer:
|
||||
#ifndef LONG_INT_H
|
||||
#define LONG_INT_H
|
||||
#ifdef BIT64
|
||||
typedef int64_t MilanLongInt;
|
||||
typedef MPI_LONG MilanMpiLongInt;
|
||||
#else
|
||||
typedef int32_t MilanLongInt;
|
||||
typedef MPI_INT MilanMpiLongInt;
|
||||
#endif
|
||||
#endif
|
||||
|
||||
// Regular boolean
|
||||
#ifndef BOOL_H
|
||||
#define BOOL_H
|
||||
typedef bool MilanBool;
|
||||
#endif
|
||||
//Regular boolean
|
||||
#ifndef BOOL_H
|
||||
#define BOOL_H
|
||||
typedef bool MilanBool;
|
||||
#endif
|
||||
|
||||
// Regular double and absolute value computation:
|
||||
#ifndef REAL_H
|
||||
#define REAL_H
|
||||
typedef double MilanReal;
|
||||
typedef MPI_DOUBLE MilanMpiReal;
|
||||
inline MilanReal MilanAbs(MilanReal value)
|
||||
{
|
||||
return fabs(value);
|
||||
}
|
||||
#endif
|
||||
//Regular double and absolute value computation:
|
||||
#ifndef REAL_H
|
||||
#define REAL_H
|
||||
typedef double MilanReal;
|
||||
typedef MPI_DOUBLE MilanMpiReal;
|
||||
inline MilanReal MilanAbs(MilanReal value)
|
||||
{
|
||||
return fabs(value);
|
||||
}
|
||||
#endif
|
||||
|
||||
// Regular float and absolute value computation:
|
||||
#ifndef FLOAT_H
|
||||
#define FLOAT_H
|
||||
typedef float MilanFloat;
|
||||
typedef MPI_FLOAT MilanMpiFloat;
|
||||
inline MilanFloat MilanAbsFloat(MilanFloat value)
|
||||
{
|
||||
return fabs(value);
|
||||
}
|
||||
#endif
|
||||
//Regular float and absolute value computation:
|
||||
#ifndef FLOAT_H
|
||||
#define FLOAT_H
|
||||
typedef float MilanFloat;
|
||||
typedef MPI_FLOAT MilanMpiFloat;
|
||||
inline MilanFloat MilanAbsFloat(MilanFloat value)
|
||||
{
|
||||
return fabs(value);
|
||||
}
|
||||
#endif
|
||||
|
||||
//// Define the limits:
|
||||
#ifndef LIMITS_H
|
||||
#define LIMITS_H
|
||||
// Integer Maximum and Minimum:
|
||||
// #define MilanIntMax INT_MAX
|
||||
// #define MilanIntMin INT_MIN
|
||||
#define MilanIntMax INT32_MAX
|
||||
#define MilanIntMin INT32_MIN
|
||||
//// Define the limits:
|
||||
#ifndef LIMITS_H
|
||||
#define LIMITS_H
|
||||
//Integer Maximum and Minimum:
|
||||
// #define MilanIntMax INT_MAX
|
||||
// #define MilanIntMin INT_MIN
|
||||
#define MilanIntMax INT32_MAX
|
||||
#define MilanIntMin INT32_MIN
|
||||
|
||||
#ifdef BIT64
|
||||
#define MilanLongIntMax INT64_MAX
|
||||
#define MilanLongIntMin -INT64_MAX
|
||||
#else
|
||||
#define MilanLongIntMax INT32_MAX
|
||||
#define MilanLongIntMin -INT32_MAX
|
||||
#endif
|
||||
#ifdef BIT64
|
||||
#define MilanLongIntMax INT64_MAX
|
||||
#define MilanLongIntMin -INT64_MAX
|
||||
#else
|
||||
#define MilanLongIntMax INT32_MAX
|
||||
#define MilanLongIntMin -INT32_MAX
|
||||
#endif
|
||||
|
||||
#endif
|
||||
#endif
|
||||
|
||||
// +INFINITY
|
||||
const double PLUS_INFINITY = numeric_limits<int>::infinity();
|
||||
const double MINUS_INFINITY = -PLUS_INFINITY;
|
||||
//#define MilanRealMax LDBL_MAX
|
||||
#define MilanRealMax PLUS_INFINITY
|
||||
#define MilanRealMin MINUS_INFINITY
|
||||
//#define MilanRealMax LDBL_MAX
|
||||
#define MilanRealMax PLUS_INFINITY
|
||||
#define MilanRealMin MINUS_INFINITY
|
||||
#endif
|
||||
|
||||
// Function of find the owner of a ghost vertex using binary search:
|
||||
MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
|
||||
MilanInt myRank, MilanInt numProcs);
|
||||
//Function of find the owner of a ghost vertex using binary search:
|
||||
inline MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
|
||||
MilanInt myRank, MilanInt numProcs);
|
||||
|
||||
MilanLongInt firstComputeCandidateMate(MilanLongInt adj1,
|
||||
MilanLongInt adj2,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanReal *edgeLocWeight);
|
||||
void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC
|
||||
(
|
||||
MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight,
|
||||
MilanLongInt* verDistance,
|
||||
MilanLongInt* Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
|
||||
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
|
||||
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
|
||||
MilanLongInt* ph1_card, MilanLongInt* ph2_card );
|
||||
|
||||
void queuesTransfer(vector<MilanLongInt> &U,
|
||||
vector<MilanLongInt> &privateU,
|
||||
vector<MilanLongInt> &QLocalVtx,
|
||||
vector<MilanLongInt> &QGhostVtx,
|
||||
vector<MilanLongInt> &QMsgType,
|
||||
vector<MilanInt> &QOwner,
|
||||
vector<MilanLongInt> &privateQLocalVtx,
|
||||
vector<MilanLongInt> &privateQGhostVtx,
|
||||
vector<MilanLongInt> &privateQMsgType,
|
||||
vector<MilanInt> &privateQOwner);
|
||||
void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC
|
||||
(
|
||||
MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight,
|
||||
MilanLongInt* verDistance,
|
||||
MilanLongInt* Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
|
||||
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
|
||||
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
|
||||
MilanLongInt* ph1_card, MilanLongInt* ph2_card );
|
||||
|
||||
bool isAlreadyMatched(MilanLongInt node,
|
||||
MilanLongInt StartIndex,
|
||||
MilanLongInt EndIndex,
|
||||
vector<MilanLongInt> &GMate,
|
||||
MilanLongInt *Mate,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
|
||||
void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight,
|
||||
MilanLongInt* verDistance,
|
||||
MilanLongInt* Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
|
||||
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
|
||||
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
|
||||
MilanLongInt* ph1_card, MilanLongInt* ph2_card );
|
||||
|
||||
MilanLongInt computeCandidateMate(MilanLongInt adj1,
|
||||
MilanLongInt adj2,
|
||||
MilanReal *edgeLocWeight,
|
||||
MilanLongInt k,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanLongInt StartIndex,
|
||||
MilanLongInt EndIndex,
|
||||
vector<MilanLongInt> &GMate,
|
||||
MilanLongInt *Mate,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
|
||||
|
||||
void initialize(MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt StartIndex, MilanLongInt EndIndex,
|
||||
MilanLongInt *numGhostEdgesPtr,
|
||||
MilanLongInt *numGhostVerticesPtr,
|
||||
MilanLongInt *S,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanLongInt *verLocPtr,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
|
||||
vector<MilanLongInt> &Counter,
|
||||
vector<MilanLongInt> &verGhostPtr,
|
||||
vector<MilanLongInt> &verGhostInd,
|
||||
vector<MilanLongInt> &tempCounter,
|
||||
vector<MilanLongInt> &GMate,
|
||||
vector<MilanLongInt> &Message,
|
||||
vector<MilanLongInt> &QLocalVtx,
|
||||
vector<MilanLongInt> &QGhostVtx,
|
||||
vector<MilanLongInt> &QMsgType,
|
||||
vector<MilanInt> &QOwner,
|
||||
MilanLongInt *&candidateMate,
|
||||
vector<MilanLongInt> &U,
|
||||
vector<MilanLongInt> &privateU,
|
||||
vector<MilanLongInt> &privateQLocalVtx,
|
||||
vector<MilanLongInt> &privateQGhostVtx,
|
||||
vector<MilanLongInt> &privateQMsgType,
|
||||
vector<MilanInt> &privateQOwner);
|
||||
|
||||
void clean(MilanLongInt NLVer,
|
||||
MilanInt myRank,
|
||||
MilanLongInt MessageIndex,
|
||||
vector<MPI_Request> &SRequest,
|
||||
vector<MPI_Status> &SStatus,
|
||||
MilanInt BufferSize,
|
||||
MilanLongInt *Buffer,
|
||||
MilanLongInt msgActual,
|
||||
MilanLongInt *msgActualSent,
|
||||
MilanLongInt msgInd,
|
||||
MilanLongInt *msgIndSent,
|
||||
MilanLongInt NumMessagesBundled,
|
||||
MilanReal *msgPercent);
|
||||
|
||||
void PARALLEL_COMPUTE_CANDIDATE_MATE_B(MilanLongInt NLVer,
|
||||
MilanLongInt *verLocPtr,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanInt myRank,
|
||||
MilanReal *edgeLocWeight,
|
||||
MilanLongInt *candidateMate);
|
||||
|
||||
void PARALLEL_PROCESS_EXPOSED_VERTEX_B(MilanLongInt NLVer,
|
||||
MilanLongInt *candidateMate,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanLongInt *verLocPtr,
|
||||
MilanLongInt StartIndex,
|
||||
MilanLongInt EndIndex,
|
||||
MilanLongInt *Mate,
|
||||
vector<MilanLongInt> &GMate,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
|
||||
MilanReal *edgeLocWeight,
|
||||
MilanLongInt *myCardPtr,
|
||||
MilanLongInt *msgIndPtr,
|
||||
MilanLongInt *NumMessagesBundledPtr,
|
||||
MilanLongInt *SPtr,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *PCounter,
|
||||
vector<MilanLongInt> &Counter,
|
||||
MilanInt myRank,
|
||||
MilanInt numProcs,
|
||||
vector<MilanLongInt> &U,
|
||||
vector<MilanLongInt> &privateU,
|
||||
vector<MilanLongInt> &QLocalVtx,
|
||||
vector<MilanLongInt> &QGhostVtx,
|
||||
vector<MilanLongInt> &QMsgType,
|
||||
vector<MilanInt> &QOwner,
|
||||
vector<MilanLongInt> &privateQLocalVtx,
|
||||
vector<MilanLongInt> &privateQGhostVtx,
|
||||
vector<MilanLongInt> &privateQMsgType,
|
||||
vector<MilanInt> &privateQOwner);
|
||||
|
||||
void PROCESS_CROSS_EDGE(MilanLongInt *edge,
|
||||
MilanLongInt *SPtr);
|
||||
|
||||
void processMatchedVertices(
|
||||
MilanLongInt NLVer,
|
||||
vector<MilanLongInt> &UChunkBeingProcessed,
|
||||
vector<MilanLongInt> &U,
|
||||
vector<MilanLongInt> &privateU,
|
||||
MilanLongInt StartIndex,
|
||||
MilanLongInt EndIndex,
|
||||
MilanLongInt *myCardPtr,
|
||||
MilanLongInt *msgIndPtr,
|
||||
MilanLongInt *NumMessagesBundledPtr,
|
||||
MilanLongInt *SPtr,
|
||||
MilanLongInt *verLocPtr,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *PCounter,
|
||||
vector<MilanLongInt> &Counter,
|
||||
MilanInt myRank,
|
||||
MilanInt numProcs,
|
||||
MilanLongInt *candidateMate,
|
||||
vector<MilanLongInt> &GMate,
|
||||
MilanLongInt *Mate,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
|
||||
MilanReal *edgeLocWeight,
|
||||
vector<MilanLongInt> &QLocalVtx,
|
||||
vector<MilanLongInt> &QGhostVtx,
|
||||
vector<MilanLongInt> &QMsgType,
|
||||
vector<MilanInt> &QOwner,
|
||||
vector<MilanLongInt> &privateQLocalVtx,
|
||||
vector<MilanLongInt> &privateQGhostVtx,
|
||||
vector<MilanLongInt> &privateQMsgType,
|
||||
vector<MilanInt> &privateQOwner);
|
||||
|
||||
void processMatchedVerticesAndSendMessages(
|
||||
MilanLongInt NLVer,
|
||||
vector<MilanLongInt> &UChunkBeingProcessed,
|
||||
vector<MilanLongInt> &U,
|
||||
vector<MilanLongInt> &privateU,
|
||||
MilanLongInt StartIndex,
|
||||
MilanLongInt EndIndex,
|
||||
MilanLongInt *myCardPtr,
|
||||
MilanLongInt *msgIndPtr,
|
||||
MilanLongInt *NumMessagesBundledPtr,
|
||||
MilanLongInt *SPtr,
|
||||
MilanLongInt *verLocPtr,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *PCounter,
|
||||
vector<MilanLongInt> &Counter,
|
||||
MilanInt myRank,
|
||||
MilanInt numProcs,
|
||||
MilanLongInt *candidateMate,
|
||||
vector<MilanLongInt> &GMate,
|
||||
MilanLongInt *Mate,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
|
||||
MilanReal *edgeLocWeight,
|
||||
vector<MilanLongInt> &QLocalVtx,
|
||||
vector<MilanLongInt> &QGhostVtx,
|
||||
vector<MilanLongInt> &QMsgType,
|
||||
vector<MilanInt> &QOwner,
|
||||
vector<MilanLongInt> &privateQLocalVtx,
|
||||
vector<MilanLongInt> &privateQGhostVtx,
|
||||
vector<MilanLongInt> &privateQMsgType,
|
||||
vector<MilanInt> &privateQOwner,
|
||||
MPI_Comm comm,
|
||||
MilanLongInt *msgActual,
|
||||
vector<MilanLongInt> &Message);
|
||||
|
||||
void sendBundledMessages(MilanLongInt *numGhostEdgesPtr,
|
||||
MilanInt *BufferSizePtr,
|
||||
MilanLongInt *Buffer,
|
||||
vector<MilanLongInt> &PCumulative,
|
||||
vector<MilanLongInt> &PMessageBundle,
|
||||
vector<MilanLongInt> &PSizeInfoMessages,
|
||||
MilanLongInt *PCounter,
|
||||
MilanLongInt NumMessagesBundled,
|
||||
MilanLongInt *msgActualPtr,
|
||||
MilanLongInt *MessageIndexPtr,
|
||||
MilanInt numProcs,
|
||||
MilanInt myRank,
|
||||
MPI_Comm comm,
|
||||
vector<MilanLongInt> &QLocalVtx,
|
||||
vector<MilanLongInt> &QGhostVtx,
|
||||
vector<MilanLongInt> &QMsgType,
|
||||
vector<MilanInt> &QOwner,
|
||||
vector<MPI_Request> &SRequest,
|
||||
vector<MPI_Status> &SStatus);
|
||||
|
||||
void processMessages(
|
||||
MilanLongInt NLVer,
|
||||
MilanLongInt *Mate,
|
||||
MilanLongInt *candidateMate,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
|
||||
vector<MilanLongInt> &GMate,
|
||||
vector<MilanLongInt> &Counter,
|
||||
MilanLongInt StartIndex,
|
||||
MilanLongInt EndIndex,
|
||||
MilanLongInt *myCardPtr,
|
||||
MilanLongInt *msgIndPtr,
|
||||
MilanLongInt *msgActualPtr,
|
||||
MilanReal *edgeLocWeight,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *verLocPtr,
|
||||
MilanLongInt k,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanInt numProcs,
|
||||
MilanInt myRank,
|
||||
MPI_Comm comm,
|
||||
vector<MilanLongInt> &Message,
|
||||
MilanLongInt numGhostEdges,
|
||||
MilanLongInt u,
|
||||
MilanLongInt v,
|
||||
MilanLongInt *SPtr,
|
||||
vector<MilanLongInt> &U);
|
||||
|
||||
void extractUChunk(
|
||||
vector<MilanLongInt> &UChunkBeingProcessed,
|
||||
vector<MilanLongInt> &U,
|
||||
vector<MilanLongInt> &privateU);
|
||||
|
||||
void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
|
||||
MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
|
||||
MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
|
||||
MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
|
||||
MilanLongInt *ph1_card, MilanLongInt *ph2_card);
|
||||
|
||||
void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
|
||||
MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
|
||||
MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
|
||||
MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
|
||||
MilanLongInt *ph1_card, MilanLongInt *ph2_card);
|
||||
|
||||
void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
|
||||
MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanFloat *edgeLocWeight,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
|
||||
MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
|
||||
MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
|
||||
MilanLongInt *ph1_card, MilanLongInt *ph2_card);
|
||||
|
||||
void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
|
||||
MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
|
||||
MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
|
||||
MilanLongInt *ph1_card, MilanLongInt *ph2_card);
|
||||
|
||||
void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanFloat *edgeLocWeight,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
|
||||
MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
|
||||
MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
|
||||
MilanLongInt *ph1_card, MilanLongInt *ph2_card);
|
||||
void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight,
|
||||
MilanLongInt* verDistance,
|
||||
MilanLongInt* Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
|
||||
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
|
||||
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
|
||||
MilanLongInt* ph1_card, MilanLongInt* ph2_card );
|
||||
|
||||
#endif
|
||||
#ifdef __cplusplus
|
||||
|
||||
@@ -72,6 +72,12 @@
|
||||
|
||||
#ifdef SERIAL_MPI
|
||||
#else
|
||||
//MPI type map
|
||||
template<typename T> MPI_Datatype TypeMap();
|
||||
template<> inline MPI_Datatype TypeMap<int64_t>() { return MPI_LONG_LONG; }
|
||||
template<> inline MPI_Datatype TypeMap<int>() { return MPI_INT; }
|
||||
template<> inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
|
||||
template<> inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
|
||||
|
||||
// DOUBLE PRECISION VERSION
|
||||
//WARNING: The vertex block on a given rank is contiguous
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user