Compare commits

..
1 Commits
Author SHA1 Message Date
Cirdans-Home a2a1532b90 Added rkr solver 2020-11-30 23:07:52 +01:00
912 changed files with 33212 additions and 55891 deletions
+1 -1
View File
@@ -4,7 +4,7 @@
Algebraic Multigrid Package
based on PSBLAS (Parallel Sparse BLAS version 3.7)
(C) Copyright 2021
(C) Copyright 2020
Salvatore Filippone
Pasqua D'Ambra
+8 -10
View File
@@ -2,10 +2,10 @@
.mod=@MODEXT@
.fh=.fh
.SUFFIXES:
.SUFFIXES: .f90 .F90 .f .F .c .cpp .o
.SUFFIXES: .f90 .F90 .f .F .c .o
##########################################################
# #
# Note: directories external to the AMG4PSBLAS subtree #
# Note: directories external to the MLD2P4 subtree #
# must be specified here with absolute pathnames #
# #
##########################################################
@@ -16,7 +16,6 @@ PSBLAS_LIBDIR=@PSBLAS_LIBDIR@
@PSBLAS_INSTALL_MAKEINC@
PSBLAS_INCLUDES=@PSBLAS_INCLUDES@
PSBLAS_LIBS=@PSBLAS_LIBS@
PSBBASEMODNAME=psb_base_mod
@@ -70,16 +69,15 @@ EXTRALIBS=@EXTRA_LIBS@
#
AMGCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
CDEFINES=$(AMGCDEFINES)
AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
FDEFINES=$(AMGFDEFINES)
MLDCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
MLDFDEFINES=@FDEFINES@ $(PSBFDEFINES)
CXXDEFINES=@AMGCXXDEFINES@
CDEFINES=$(MLDCDEFINES)
FDEFINES=$(MLDFDEFINES)
@COMPILERULES@
AMGLDLIBS=$(MUMPSLIBS) $(SLULIBS) $(SLUDISTLIBS) $(UMFLIBS) $(EXTRALIBS) $(PSBLDLIBS) -lstdc++
LDLIBS=$(AMGLDLIBS)
MLDLDLIBS=$(MUMPSLIBS) $(SLULIBS) $(SLUDISTLIBS) $(UMFLIBS) $(EXTRALIBS) $(PSBLDLIBS)
LDLIBS=$(MLDLDLIBS)
-120
View File
@@ -1,120 +0,0 @@
##########################################################
.mod=@MODEXT@
.fh=.fh
.SUFFIXES:
.SUFFIXES: .f90 .F90 .f .F .c .cpp .o
# The following ones are the variables used by the PSBLAS make scripts.
FC=@FC@
CC=@CC@
CXX=@CXX@
FCOPT=@FCOPT@
CCOPT=@CCOPT@
CXXOPT=@CXXOPT@
FMFLAG=@FMFLAG@
FIFLAG=@FIFLAG@
EXTRA_OPT=@EXTRA_OPT@
# These three should be always set!
MPFC=@MPIFC@
MPCC=@MPICC@
MPCXX=@MPICXX@
FLINK=@FLINK@
LIBS=@LIBS@
# BLAS, BLACS and METIS libraries.
BLAS=@BLAS_LIBS@
METIS_LIB=@METIS_LIBS@
LAPACK=@LAPACK_LIBS@
PSBFDEFINES=@FDEFINES@
PSBCDEFINES=@CDEFINES@
PSBCXXDEFINES=@CDEFINES@
AR=@AR@
RANLIB=@RANLIB@
##########################################################
# #
# Note: directories external to the AMG4PSBLAS subtree #
# must be specified here with absolute pathnames #
# #
##########################################################
PSBLASDIR=@PSBLAS_DIR@
PSBLAS_INCDIR=@PSBLAS_INCDIR@
PSBLAS_MODDIR=@PSBLAS_MODDIR@
PSBLAS_LIBDIR=@PSBLAS_LIBDIR@
PSBLAS_INCLUDES=@PSBLAS_INCLUDES@
PSBLAS_LIBS=@PSBLAS_LIBS@
PSBBASEMODNAME=psb_base_mod
PSBPRECMODNAME=psb_prec_mod
PSBMETHDMODNAME=psb_krylov_mod
PSBUTILMODNAME=psb_util_mod
INSTALL=@INSTALL@
INSTALL_DATA=@INSTALL_DATA@
INSTALL_DIR=@INSTALL_DIR@
INSTALL_LIBDIR=@INSTALL_LIBDIR@
INSTALL_INCLUDEDIR=@INSTALL_INCLUDEDIR@
INSTALL_MODULESDIR=@INSTALL_MODULESDIR@
INSTALL_DOCSDIR=@INSTALL_DOCSDIR@
INSTALL_SAMPLESDIR=@INSTALL_SAMPLESDIR@
##########################################################
# #
# Additional defines and libraries for multilevel #
# Note that these libraries should be compatible #
# (compiled with) the compilers specified in the #
# PSBLAS main Make.inc #
# #
# Examples: #
# MUMPSLIBS=-ldmumps -lmumps_common #
# -lpord -L/path/to/MUMPS/lib #
# MUMPSFLAGS=-DHave_MUMPS_ -I/path/to/MUMPS/include #
# #
# UMFLIBS=-lumfpack -lamd -L/path/to/UMFPACK #
# UMFFLAGS=-DHave_UMF_ -I/path/to/UMFPACK #
# #
# SLULIBS=-lslu -L/path/to/SuperLU #
# SLUFLAGS=-DHave_SLU_ -I/path/to/SuperLU #
# #
# SLUDISTLIBS=-lslud -L/path/to/SuperLUDist #
# SLUDISTFLAGS=-DHave_SLUDist_ -I/path/to/SuperLUDist #
# #
##########################################################
MUMPSLIBS=@MUMPS_LIBS@
MUMPSFLAGS=@MUMPS_FLAGS@
SLULIBS=@SLU_LIBS@
SLUFLAGS=@SLU_FLAGS@
SLUDISTLIBS=@SLUDIST_LIBS@
SLUDISTFLAGS=@SLUDIST_FLAGS@
UMFLIBS=@UMF_LIBS@
UMFFLAGS=@UMF_FLAGS@
EXTRALIBS=@EXTRA_LIBS@
@COMPILERULES@
#
AMGCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
CDEFINES=$(AMGCDEFINES)
AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
FDEFINES=$(AMGFDEFINES)
CXXDEFINES=@AMGCXXDEFINES@ $(PSBCXXDEFINES)
AMGLDLIBS=$(MUMPSLIBS) $(SLULIBS) $(SLUDISTLIBS) $(UMFLIBS) $(EXTRALIBS) $(PSBLDLIBS) -lstdc++
LDLIBS=$(AMGLDLIBS)
+8 -8
View File
@@ -3,7 +3,7 @@ include Make.inc
all: library
library: libdir amgp cbnd
library: libdir amgp
#cbnd
libdir:
@@ -33,8 +33,8 @@ install: all
mkdir -p $(INSTALL_SAMPLESDIR) && \
mkdir -p $(INSTALL_SAMPLESDIR)/simple &&\
mkdir -p $(INSTALL_SAMPLESDIR)/advanced && \
(cd samples/simple; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/simple ) && \
(cd samples/advanced; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/advanced )
(cd examples; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/simple ) && \
(cd tests; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/advanced )
cleanlib:
(cd lib; /bin/rm -f *.a *$(.mod) *$(.fh))
(cd include; /bin/rm -f *.a *$(.mod) *$(.fh))
@@ -42,13 +42,13 @@ cleanlib:
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 examples/fileread; make clean)
(cd examples/pdegen; make clean)
(cd tests/fileread; make clean)
(cd tests/pdegen; make clean)
check: all
make check -C samples/advanced/pdegen
make check -C tests/pdegen
clean:
(cd amgprec; make clean)
+21 -24
View File
@@ -15,8 +15,9 @@ DMODOBJS=amg_d_prec_type.o \
amg_d_base_aggregator_mod.o \
amg_d_dec_aggregator_mod.o amg_d_symdec_aggregator_mod.o \
amg_d_ainv_solver.o amg_d_base_ainv_mod.o \
amg_d_invk_solver.o amg_d_invt_solver.o amg_d_krm_solver.o \
amg_d_matchboxp_mod.o amg_d_parmatch_aggregator_mod.o
amg_d_invk_solver.o amg_d_invt_solver.o \
amg_d_rkr_solver.o
#amg_d_bcmatch_aggregator_mod.o
SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \
amg_s_inner_mod.o amg_s_ilu_solver.o amg_s_diag_solver.o amg_s_jac_smoother.o amg_s_as_smoother.o \
@@ -26,8 +27,8 @@ SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.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 \
amg_s_invk_solver.o amg_s_invt_solver.o amg_s_krm_solver.o \
amg_s_matchboxp_mod.o amg_s_parmatch_aggregator_mod.o
amg_s_invk_solver.o amg_s_invt_solver.o \
amg_s_rkr_solver.o
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 \
@@ -37,7 +38,8 @@ ZMODOBJS=amg_z_prec_type.o amg_z_ilu_fact_mod.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 \
amg_z_invk_solver.o amg_z_invt_solver.o amg_z_krm_solver.o
amg_z_invk_solver.o amg_z_invt_solver.o \
amg_z_rkr_solver.o
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 \
@@ -47,7 +49,8 @@ CMODOBJS=amg_c_prec_type.o amg_c_ilu_fact_mod.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 \
amg_c_invk_solver.o amg_c_invt_solver.o amg_c_krm_solver.o
amg_c_invk_solver.o amg_c_invt_solver.o \
amg_c_rkr_solver.o
@@ -75,21 +78,12 @@ lib: $(OBJS) impld
/bin/cp -p *$(.mod) $(MODDIR)
$(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
$(MODOBJS): $(PSBLAS_MODDIR)/$(BASEMODNAME)$(.mod)
amg_base_prec_type.o: amg_const.h
amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o : amg_base_prec_type.o
amg_prec_type.o: amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o
amg_prec_mod.o: amg_prec_type.o amg_s_prec_mod.o amg_d_prec_mod.o amg_c_prec_mod.o amg_z_prec_mod.o
amg_s_krm_solver.o: amg_s_prec_type.o amg_s_base_solver_mod.o
amg_d_krm_solver.o: amg_d_prec_type.o amg_d_base_solver_mod.o
amg_c_krm_solver.o: amg_c_prec_type.o amg_c_base_solver_mod.o
amg_z_krm_solver.o: amg_z_prec_type.o amg_z_base_solver_mod.o
amg_s_prec_mod.o: amg_s_krm_solver.o
amg_d_prec_mod.o: amg_d_krm_solver.o
amg_c_prec_mod.o: amg_c_krm_solver.o
amg_z_prec_mod.o: amg_z_krm_solver.o
$(SINNEROBJS) $(SOUTEROBJS): $(SMODOBJS)
$(DINNEROBJS) $(DOUTEROBJS): $(DMODOBJS)
@@ -112,27 +106,25 @@ amg_d_prec_type.o: amg_d_onelev_mod.o
amg_c_prec_type.o: amg_c_onelev_mod.o
amg_z_prec_type.o: amg_z_onelev_mod.o
amg_s_onelev_mod.o: amg_s_base_smoother_mod.o amg_s_dec_aggregator_mod.o amg_s_parmatch_aggregator_mod.o
amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o amg_d_parmatch_aggregator_mod.o
amg_s_onelev_mod.o: amg_s_base_smoother_mod.o amg_s_dec_aggregator_mod.o
amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o
amg_c_onelev_mod.o: amg_c_base_smoother_mod.o amg_c_dec_aggregator_mod.o
amg_z_onelev_mod.o: amg_z_base_smoother_mod.o amg_z_dec_aggregator_mod.o
amg_s_base_aggregator_mod.o: amg_base_prec_type.o
amg_s_parmatch_aggregator_mod.o amg_s_dec_aggregator_mod.o: amg_s_base_aggregator_mod.o
amg_s_dec_aggregator_mod.o: amg_s_base_aggregator_mod.o
amg_s_hybrid_aggregator_mod.o amg_s_symdec_aggregator_mod.o: amg_s_dec_aggregator_mod.o
amg_s_parmatch_aggregator_mod.o: amg_s_matchboxp_mod.o
amg_d_base_aggregator_mod.o: amg_base_prec_type.o
amg_d_parmatch_aggregator_mod.o amg_d_dec_aggregator_mod.o: amg_d_base_aggregator_mod.o
amg_d_dec_aggregator_mod.o: amg_d_base_aggregator_mod.o
amg_d_hybrid_aggregator_mod.o amg_d_symdec_aggregator_mod.o: amg_d_dec_aggregator_mod.o
amg_d_parmatch_aggregator_mod.o: amg_d_matchboxp_mod.o
amg_c_base_aggregator_mod.o: amg_base_prec_type.o
amg_c_parmatch_aggregator_mod.o amg_c_dec_aggregator_mod.o: amg_c_base_aggregator_mod.o
amg_c_dec_aggregator_mod.o: amg_c_base_aggregator_mod.o
amg_c_hybrid_aggregator_mod.o amg_c_symdec_aggregator_mod.o: amg_c_dec_aggregator_mod.o
amg_z_base_aggregator_mod.o: amg_base_prec_type.o
amg_z_parmatch_aggregator_mod.o amg_z_dec_aggregator_mod.o: amg_z_base_aggregator_mod.o
amg_z_dec_aggregator_mod.o: amg_z_base_aggregator_mod.o
amg_z_hybrid_aggregator_mod.o amg_z_symdec_aggregator_mod.o: amg_z_dec_aggregator_mod.o
amg_s_base_smoother_mod.o: amg_s_base_solver_mod.o
@@ -149,6 +141,11 @@ amg_c_base_ainv_mod.o: amg_c_base_solver_mod.o amg_base_ainv_mod.o
amg_d_base_ainv_mod.o: amg_d_base_solver_mod.o amg_base_ainv_mod.o
amg_z_base_ainv_mod.o: amg_z_base_solver_mod.o amg_base_ainv_mod.o
amg_d_rkr_solver.o: amg_d_base_solver_mod.o amg_d_prec_type.o
amg_s_rkr_solver.o: amg_s_base_solver_mod.o amg_s_prec_type.o
amg_c_rkr_solver.o: amg_c_base_solver_mod.o amg_c_prec_type.o
amg_z_rkr_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.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 \
File diff suppressed because it is too large Load Diff
+48 -50
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
@@ -61,9 +58,10 @@ module amg_c_ainv_solver
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
!!$ procedure, pass(sv) :: seti => amg_c_ainv_solver_seti
!!$ procedure, pass(sv) :: setc => amg_c_ainv_solver_setc
!!$ procedure, pass(sv) :: setr => amg_c_ainv_solver_setr
procedure, pass(sv) :: seti => amg_c_ainv_solver_seti
procedure, pass(sv) :: setc => amg_c_ainv_solver_setc
procedure, pass(sv) :: setr => amg_c_ainv_solver_setr
generic, public :: set => seti, setr, setc
procedure, pass(sv) :: descr => amg_c_ainv_solver_descr
procedure, pass(sv) :: default => c_ainv_solver_default
procedure, nopass :: stringval => c_ainv_stringval
@@ -161,44 +159,44 @@ module amg_c_ainv_solver
end subroutine amg_c_ainv_solver_csetr
end interface
!!$ interface
!!$ subroutine amg_c_ainv_solver_setc(sv,what,val,info)
!!$ import :: amg_c_ainv_solver_type, psb_ipk_
!!$ Implicit none
!!$ ! Arguments
!!$ class(amg_c_ainv_solver_type), intent(inout) :: sv
!!$ integer(psb_ipk_), intent(in) :: what
!!$ character(len=*), intent(in) :: val
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_c_ainv_solver_setc
!!$ end interface
!!$
!!$ interface
!!$ subroutine amg_c_ainv_solver_seti(sv,what,val,info)
!!$ import :: amg_c_ainv_solver_type, psb_ipk_
!!$ Implicit none
!!$ ! Arguments
!!$ class(amg_c_ainv_solver_type), intent(inout) :: sv
!!$ integer(psb_ipk_), intent(in) :: what
!!$ integer(psb_ipk_), intent(in) :: val
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_c_ainv_solver_seti
!!$ end interface
!!$
!!$ interface
!!$ subroutine amg_c_ainv_solver_setr(sv,what,val,info)
!!$ import :: amg_c_ainv_solver_type, psb_ipk_, psb_spk_
!!$ Implicit none
!!$ ! Arguments
!!$ class(amg_c_ainv_solver_type), intent(inout) :: sv
!!$ integer(psb_ipk_), intent(in) :: what
!!$ real(psb_spk_), intent(in) :: val
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_c_ainv_solver_setr
!!$ end interface
interface
subroutine amg_c_ainv_solver_setc(sv,what,val,info)
import :: amg_c_ainv_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_c_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_ainv_solver_setc
end interface
interface
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_c_ainv_solver_seti(sv,what,val,info)
import :: amg_c_ainv_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_c_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_ainv_solver_seti
end interface
interface
subroutine amg_c_ainv_solver_setr(sv,what,val,info)
import :: amg_c_ainv_solver_type, psb_ipk_, psb_spk_
Implicit none
! Arguments
class(amg_c_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_ainv_solver_setr
end interface
interface
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
Implicit None
@@ -208,7 +206,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
+11 -18
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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)
+7 -14
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -126,7 +126,7 @@ module amg_c_base_aggregator_mod
& psb_c_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
implicit none
type(psb_c_csr_sparse_mat), intent(inout) :: a_csr
type(psb_desc_type), intent(inout) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: nlaggr(:)
type(amg_sml_parms), intent(inout) :: parms
type(psb_c_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -144,7 +144,7 @@ module amg_c_base_aggregator_mod
& psb_c_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
implicit none
type(psb_c_csr_sparse_mat), intent(inout) :: a_csr
type(psb_desc_type), intent(inout) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: nlaggr(:)
type(amg_sml_parms), intent(inout) :: parms
type(psb_c_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -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
+7 -10
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
+3 -4
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+4 -4
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+6 -13
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+8 -22
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+14 -28
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+1 -1
View File
@@ -2,7 +2,7 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
+5 -12
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+2 -2
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
+9 -16
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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)
+3 -3
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -39,7 +39,7 @@
!
! Module: amg_inner_mod
!
! This module defines the interfaces to inner AMG4PSBLAS routines.
! This module defines the interfaces to inner MLD2P4 routines.
! The interfaces of the user level routines are defined in amg_prec_mod.f90.
!
module amg_c_inner_mod
+23 -12
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
@@ -54,6 +51,8 @@ module amg_c_invk_solver
procedure, pass(sv) :: clone => amg_c_invk_solver_clone
procedure, pass(sv) :: build => amg_c_invk_solver_bld
procedure, pass(sv) :: cseti => amg_c_invk_solver_cseti
procedure, pass(sv) :: seti => amg_c_invk_solver_seti
generic, public :: set => seti
procedure, pass(sv) :: descr => amg_c_invk_solver_descr
procedure, pass(sv) :: default => c_invk_solver_default
end type amg_c_invk_solver_type
@@ -123,7 +122,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
@@ -133,10 +132,22 @@ 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
interface
subroutine amg_c_invk_solver_seti(sv,what,val,info)
import :: amg_c_invk_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_c_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_invk_solver_seti
end interface
contains
subroutine c_invk_solver_default(sv)
+38 -15
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
@@ -55,6 +52,9 @@ module amg_c_invt_solver
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
procedure, pass(sv) :: seti => amg_c_invt_solver_seti
procedure, pass(sv) :: setr => amg_c_invt_solver_setr
generic, public :: set => seti, setr
procedure, pass(sv) :: descr => amg_c_invt_solver_descr
procedure, pass(sv) :: default => c_invt_solver_default
end type amg_c_invt_solver_type
@@ -134,21 +134,44 @@ 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
interface
subroutine amg_c_invt_solver_setr(sv,what,val,info)
import :: amg_c_invt_solver_type, psb_spk_, psb_ipk_
Implicit none
! Arguments
class(amg_c_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_invt_solver_setr
end interface
interface
subroutine amg_c_invt_solver_seti(sv,what,val,info)
import :: amg_c_invt_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_c_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine
end interface
contains
subroutine c_invt_solver_default(sv)
+8 -10
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+8 -15
View File
@@ -3,9 +3,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -313,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_
@@ -339,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
+164 -304
View File
@@ -1,15 +1,15 @@
!
!
!
!
! 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
!
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
! 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:
@@ -21,7 +21,7 @@
! 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
@@ -33,22 +33,22 @@
! 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_onelev_mod.f90
!
! Module: amg_c_onelev_mod
!
! This module defines:
! This module defines:
! - the amg_c_onelev_type data structure containing one level
! of a multilevel preconditioner and related
! data structures;
!
! It contains routines for
! - Building and applying;
! - Building and applying;
! - checking if the preconditioner is correctly defined;
! - printing a description of the preconditioner;
! - deallocating the preconditioner data structure.
! - deallocating the preconditioner data structure.
!
module amg_c_onelev_mod
@@ -56,7 +56,6 @@ module amg_c_onelev_mod
use amg_base_prec_type
use amg_c_base_smoother_mod
use amg_c_dec_aggregator_mod
use psb_base_mod, only : psb_cspmat_type, psb_c_vect_type, &
& psb_c_base_vect_type, psb_lcspmat_type, psb_clinmap_type, psb_spk_, &
& psb_ipk_, psb_epk_, psb_lpk_, psb_desc_type, psb_i_base_vect_type, &
@@ -74,16 +73,16 @@ module amg_c_onelev_mod
! class(amg_c_base_smoother_type), pointer :: sm2 => null()
! class(amg_cmlprec_wrk_type), allocatable :: wrk
! class(amg_c_base_aggregator_type), allocatable :: aggr
! type(amg_sml_parms) :: parms
! type(amg_sml_parms) :: parms
! type(psb_cspmat_type) :: ac
! type(psb_cesc_type) :: desc_ac
! type(psb_cspmat_type), pointer :: base_a => null()
! type(psb_desc_type), pointer :: base_desc => null()
! type(psb_cspmat_type), pointer :: base_a => null()
! type(psb_desc_type), pointer :: base_desc => null()
! type(psb_clinmap_type) :: map
! end type amg_conelev_type
!
! Note that s denotes the kind of the real data type to be chosen
! according to single/double precision version of AMG4PSBLAS.
! according to single/double precision version of MLD2P4.
!
! sm,sm2a - class(amg_c_base_smoother_type), allocatable
! The current level pre- and post-smooother.
@@ -94,7 +93,7 @@ module amg_c_onelev_mod
! Workspace for application of preconditioner; may be
! pre-allocated to save time in the application within a
! Krylov solver.
! aggr - class(amg_c_base_aggregator_type), allocatable
! aggr - class(amg_c_base_aggregator_type), allocatable
! The aggregator object: holds the algorithmic choices and
! (possibly) additional data for building the aggregation.
! parms - type(amg_sml_parms)
@@ -105,7 +104,7 @@ module amg_c_onelev_mod
! The communication descriptor associated to the matrix
! stored in ac.
! base_a - type(psb_cspmat_type), pointer.
! Pointer (really a pointer!) to the local part of the current
! Pointer (really a pointer!) to the local part of the current
! matrix (so we have a unified treatment of residuals).
! We need this to avoid passing explicitly the current matrix
! to the routine which applies the preconditioner.
@@ -116,13 +115,13 @@ module amg_c_onelev_mod
! vector spaces associated to the index spaces of the previous
! and current levels.
!
! Methods:
! Methods:
! Most methods follow the encapsulation hierarchy: they take whatever action
! is appropriate for the current object, then call the corresponding method for
! the contained object.
! As an example: the descr() method prints out a description of the
! level. It starts by invoking the descr() method of the parms object,
! then calls the descr() method of the smoother object.
! then calls the descr() method of the smoother object.
!
! descr - Prints a description of the object.
! default - Set default values
@@ -131,14 +130,14 @@ module amg_c_onelev_mod
! it is passed to the smoother object for further processing.
! check - Sanity checks.
! sizeof - Total memory occupation in bytes
! get_nzeros - Number of nonzeros
! get_nzeros - Number of nonzeros
! get_wrksz - How many workspace vector does apply_vect need
! allocate_wrk - Allocate auxiliary workspace
! free_wrk - Free auxiliary workspace
! bld_tprol - Invoke the aggr method to build the tentative prolongator
! mat_asb - Build the final (possibly smoothed) prolongator and coarse matrix.
!
! mat_asb - Build the final (possibly smoothed) prolongator and coarse matrix.
!
!
type amg_cmlprec_wrk_type
complex(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
type(psb_c_vect_type) :: vtx, vty, vx2l, vy2l
@@ -149,35 +148,25 @@ module amg_c_onelev_mod
procedure, pass(wk) :: clone => c_wrk_clone
procedure, pass(wk) :: move_alloc => c_wrk_move_alloc
procedure, pass(wk) :: cnv => c_wrk_cnv
procedure, pass(wk) :: sizeof => c_wrk_sizeof
procedure, pass(wk) :: sizeof => c_wrk_sizeof
end type amg_cmlprec_wrk_type
private :: c_wrk_alloc, c_wrk_free, &
& c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv, c_wrk_sizeof
type amg_c_remap_data_type
type(psb_cspmat_type) :: ac_pre_remap
type(psb_desc_type) :: desc_ac_pre_remap
integer(psb_ipk_) :: idest
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
contains
procedure, pass(rmp) :: clone => c_remap_data_clone
end type amg_c_remap_data_type
& c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv, c_wrk_sizeof
type amg_c_onelev_type
class(amg_c_base_smoother_type), allocatable :: sm, sm2a
class(amg_c_base_smoother_type), pointer :: sm2 => null()
class(amg_cmlprec_wrk_type), allocatable :: wrk
class(amg_c_base_aggregator_type), allocatable :: aggr
type(amg_sml_parms) :: parms
type(amg_sml_parms) :: parms
type(psb_cspmat_type) :: ac
integer(psb_ipk_) :: ac_nz_loc
integer(psb_lpk_) :: ac_nz_tot
type(psb_desc_type) :: desc_ac
type(psb_cspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_cspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_lcspmat_type) :: tprol
type(psb_clinmap_type) :: linmap
type(amg_c_remap_data_type) :: remap_data
type(psb_clinmap_type) :: map
real(psb_spk_) :: szratio
contains
procedure, pass(lv) :: bld_tprol => c_base_onelev_bld_tprol
@@ -198,7 +187,7 @@ module amg_c_onelev_mod
procedure, pass(lv) :: setsm => amg_c_base_onelev_setsm
procedure, pass(lv) :: setsv => amg_c_base_onelev_setsv
procedure, pass(lv) :: setag => amg_c_base_onelev_setag
generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag
generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag
procedure, pass(lv) :: sizeof => c_base_onelev_sizeof
procedure, pass(lv) :: get_nzeros => c_base_onelev_get_nzeros
procedure, pass(lv) :: get_wrksz => c_base_onelev_get_wrksize
@@ -206,14 +195,7 @@ module amg_c_onelev_mod
procedure, pass(lv) :: free_wrk => c_base_onelev_free_wrk
procedure, nopass :: stringval => amg_stringval
procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc
procedure, pass(lv) :: map_rstr_a => amg_c_base_onelev_map_rstr_a
procedure, pass(lv) :: map_prol_a => amg_c_base_onelev_map_prol_a
procedure, pass(lv) :: map_rstr_v => amg_c_base_onelev_map_rstr_v
procedure, pass(lv) :: map_prol_v => amg_c_base_onelev_map_prol_v
generic, public :: map_rstr => map_rstr_a, map_rstr_v
generic, public :: map_prol => map_prol_a, map_prol_v
end type amg_c_onelev_type
type amg_c_onelev_node
@@ -227,11 +209,11 @@ module amg_c_onelev_mod
& c_base_onelev_get_wrksize, c_base_onelev_allocate_wrk, &
& c_base_onelev_free_wrk
interface
interface
subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lcspmat_type, psb_lpk_
import :: amg_c_onelev_type
implicit none
implicit none
class(amg_c_onelev_type), intent(inout), target :: lv
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a
@@ -256,143 +238,141 @@ module amg_c_onelev_mod
end subroutine amg_c_base_onelev_build
end interface
interface
subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
interface
subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_c_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
class(amg_c_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
end subroutine amg_c_base_onelev_descr
end interface
interface
interface
subroutine amg_c_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_c_onelev_type, psb_c_base_vect_type, psb_spk_, &
& psb_c_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
! Arguments
class(amg_c_onelev_type), intent(inout) :: lv
class(amg_c_onelev_type), intent(inout) :: lv
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_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, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none
implicit none
class(amg_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_base_onelev_free
end interface
interface
interface
subroutine amg_c_base_onelev_check(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
! Arguments
class(amg_c_onelev_type), intent(inout) :: lv
class(amg_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_base_onelev_check
end interface
interface
interface
subroutine amg_c_base_onelev_setsm(lv,val,info,pos)
import :: psb_spk_, amg_c_onelev_type, amg_c_base_smoother_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_base_smoother_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine amg_c_base_onelev_setsm
end interface
interface
interface
subroutine amg_c_base_onelev_setsv(lv,val,info,pos)
import :: psb_spk_, amg_c_onelev_type, amg_c_base_solver_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_base_solver_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine amg_c_base_onelev_setsv
end interface
interface
interface
subroutine amg_c_base_onelev_setag(lv,val,info,pos)
import :: psb_spk_, amg_c_onelev_type, amg_c_base_aggregator_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_base_aggregator_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine amg_c_base_onelev_setag
end interface
interface
interface
subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
end subroutine amg_c_base_onelev_cseti
end interface
interface
interface
subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
end subroutine amg_c_base_onelev_csetc
end interface
interface
interface
subroutine amg_c_base_onelev_csetr(lv,what,val,info,pos,idx)
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
character(len=*), intent(in) :: what
class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
@@ -400,13 +380,13 @@ interface
end subroutine amg_c_base_onelev_csetr
end interface
interface
interface
subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
& solver,tprol,global_num)
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
implicit none
class(amg_c_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
@@ -414,62 +394,15 @@ interface
logical, optional, intent(in) :: ac, rp, smoother, solver, tprol, global_num
end subroutine amg_c_base_onelev_dump
end interface
interface
subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
import
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta
complex(psb_spk_), intent(inout) :: u(:)
complex(psb_spk_), intent(out) :: v(:)
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), optional :: work(:)
end subroutine amg_c_base_onelev_map_rstr_a
subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
import
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta
type(psb_c_vect_type), intent(inout) :: vect_u, vect_v
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), optional :: work(:)
type(psb_c_vect_type), optional, target, intent(inout) :: vtx,vty
end subroutine amg_c_base_onelev_map_rstr_v
end interface
interface
subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
import
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta
complex(psb_spk_), intent(inout) :: u(:)
complex(psb_spk_), intent(out) :: v(:)
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), optional :: work(:)
end subroutine amg_c_base_onelev_map_prol_a
subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
import
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta
type(psb_c_vect_type), intent(inout) :: vect_u, vect_v
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), optional :: work(:)
type(psb_c_vect_type), optional, target, intent(inout) :: vtx,vty
end subroutine amg_c_base_onelev_map_prol_v
end interface
contains
!
! Function returning the size of the amg_prec_type data structure
! in bytes or in number of nonzeros of the operator(s) involved.
! in bytes or in number of nonzeros of the operator(s) involved.
!
function c_base_onelev_get_nzeros(lv) result(val)
implicit none
implicit none
class(amg_c_onelev_type), intent(in) :: lv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
@@ -481,16 +414,16 @@ contains
end function c_base_onelev_get_nzeros
function c_base_onelev_sizeof(lv) result(val)
implicit none
implicit none
class(amg_c_onelev_type), intent(in) :: lv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = psb_sizeof_ip+psb_sizeof_lp
val = val + lv%desc_ac%sizeof()
val = val + lv%ac%sizeof()
val = val + lv%tprol%sizeof()
val = val + lv%linmap%sizeof()
val = val + lv%map%sizeof()
if (allocated(lv%sm)) val = val + lv%sm%sizeof()
if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -499,19 +432,19 @@ contains
subroutine c_base_onelev_nullify(lv)
implicit none
implicit none
class(amg_c_onelev_type), intent(inout) :: lv
nullify(lv%base_a)
nullify(lv%base_desc)
nullify(lv%base_a)
nullify(lv%base_desc)
nullify(lv%sm2)
end subroutine c_base_onelev_nullify
!
! Multilevel defaults:
! Multilevel defaults:
! multiplicative vs. additive ML framework;
! Smoothed decoupled aggregation with zero threshold;
! Smoothed decoupled aggregation with zero threshold;
! distributed coarse matrix;
! damping omega computed with the max-norm estimate of the
! dominant eigenvalue;
@@ -521,10 +454,10 @@ contains
subroutine c_base_onelev_default(lv)
Implicit None
! Arguments
class(amg_c_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_) :: info
integer(psb_ipk_) :: info
lv%parms%sweeps_pre = 1
lv%parms%sweeps_post = 1
@@ -539,7 +472,7 @@ contains
lv%parms%aggr_filter = amg_no_filter_mat_
lv%parms%aggr_omega_val = szero
lv%parms%aggr_thresh = 0.01_psb_spk_
if (allocated(lv%sm)) call lv%sm%default()
if (allocated(lv%sm2a)) then
call lv%sm2a%default()
@@ -549,7 +482,7 @@ contains
end if
if (.not.allocated(lv%aggr)) allocate(amg_c_dec_aggregator_type :: lv%aggr,stat=info)
if (allocated(lv%aggr)) call lv%aggr%default()
return
end subroutine c_base_onelev_default
@@ -564,9 +497,9 @@ contains
type(psb_lcspmat_type), intent(out) :: t_prol
type(amg_saggr_data), intent(in) :: ag_data
integer(psb_ipk_), intent(out) :: info
call lv%aggr%bld_tprol(lv%parms,ag_data,a,desc_a,ilaggr,nlaggr,t_prol,info)
end subroutine c_base_onelev_bld_tprol
@@ -576,7 +509,7 @@ contains
integer(psb_ipk_), intent(out) :: info
call lv%aggr%update_next(lvnext%aggr,info)
end subroutine c_base_onelev_update_aggr
@@ -585,33 +518,33 @@ contains
Implicit None
! Arguments
class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_onelev_type), target, intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (allocated(lv%sm)) then
if (allocated(lv%sm)) then
call lv%sm%clone(lvout%sm,info)
else
if (allocated(lvout%sm)) then
else
if (allocated(lvout%sm)) then
call lvout%sm%free(info)
if (info==psb_success_) deallocate(lvout%sm,stat=info)
end if
end if
if (allocated(lv%sm2a)) then
if (allocated(lv%sm2a)) then
call lv%sm%clone(lvout%sm2a,info)
lvout%sm2 => lvout%sm2a
else
if (allocated(lvout%sm2a)) then
else
if (allocated(lvout%sm2a)) then
call lvout%sm2a%free(info)
if (info==psb_success_) deallocate(lvout%sm2a,stat=info)
end if
lvout%sm2 => lvout%sm
end if
if (allocated(lv%aggr)) then
if (allocated(lv%aggr)) then
call lv%aggr%clone(lvout%aggr,info)
else
if (allocated(lvout%aggr)) then
if (allocated(lvout%aggr)) then
call lvout%aggr%free(info)
if (info==psb_success_) deallocate(lvout%aggr,stat=info)
end if
@@ -620,11 +553,10 @@ contains
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
if (info == psb_success_) call lv%map%clone(lvout%map,info)
lvout%base_a => lv%base_a
lvout%base_desc => lv%base_desc
return
end subroutine c_base_onelev_clone
@@ -633,12 +565,12 @@ contains
use psb_base_mod
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call b%free(info)
b%parms = lv%parms
b%szratio = lv%szratio
if (associated(lv%sm2,lv%sm2a)) then
if (associated(lv%sm2,lv%sm2a)) then
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm2a
@@ -649,18 +581,18 @@ contains
end if
call move_alloc(lv%aggr,b%aggr)
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
b%base_a => lv%base_a
b%base_desc => lv%base_desc
end subroutine c_base_onelev_move_alloc
function c_base_onelev_get_wrksize(lv) result(val)
implicit none
implicit none
class(amg_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_) :: val
@@ -681,54 +613,44 @@ contains
select case(lv%parms%ml_cycle)
case(amg_add_ml_,amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
! We're good
case(amg_kcycle_ml_, amg_kcyclesym_ml_)
!
! We need 7 in inneritkcycle.
! Can we reuse vtx?
!
! Can we reuse vtx?
!
val = val + 7
case default
! Need a better error signaling ?
val = -1
end select
end function c_base_onelev_get_wrksize
subroutine c_base_onelev_allocate_wrk(lv,info,vmold)
use psb_base_mod
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: nwv, i
info = psb_success_
nwv = lv%get_wrksz()
if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
if (info == 0) then
if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
!
! Need to fix this, we need two different allocations
!
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
& desc2=lv%remap_data%desc_ac_pre_remap)
else
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
end if
end if
if (info == 0) call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
end subroutine c_base_onelev_allocate_wrk
subroutine c_base_onelev_free_wrk(lv,info)
use psb_base_mod
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: nwv,i
integer(psb_ipk_) :: nwv,i
info = psb_success_
if (allocated(lv%wrk)) then
@@ -736,88 +658,46 @@ contains
if (info == 0) deallocate(lv%wrk,stat=info)
end if
end subroutine c_base_onelev_free_wrk
subroutine c_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
subroutine c_wrk_alloc(wk,nwv,desc,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
!
integer(psb_ipk_) :: i
info = psb_success_
call wk%free(info)
if (present(desc2)) then
!!$ write(0,*) 'Check on wrk_alloc 2',&
!!$ & desc2%get_local_rows(), desc%get_local_rows(),&
!!$ & desc2%get_local_cols(),desc%get_local_cols()
!!$ flush(0)
if (desc2%get_local_cols()>desc%get_local_cols()) then
call psb_geasb(wk%vx2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc2,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc2,info,&
& scratch=.true.,mold=vmold)
end do
else
!!$ write(0,*) 'Check on wrk_alloc 1.5 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
else
!!$ write(0,*) 'Check on wrk_alloc 1 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
end do
end subroutine c_wrk_alloc
subroutine c_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
@@ -838,7 +718,7 @@ contains
end if
end subroutine c_wrk_free
subroutine c_wrk_clone(wk,wkout,info)
use psb_base_mod
Implicit None
@@ -846,11 +726,11 @@ contains
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
class(amg_cmlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
@@ -872,12 +752,12 @@ contains
return
end subroutine c_wrk_clone
subroutine c_wrk_move_alloc(wk, b,info)
implicit none
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call b%free(info)
call move_alloc(wk%tx,b%tx)
call move_alloc(wk%ty,b%ty)
@@ -890,17 +770,17 @@ contains
call move_alloc(wk%vx2l%v,b%vx2l%v)
call move_alloc(wk%vy2l%v,b%vy2l%v)
call move_alloc(wk%wv,b%wv)
end subroutine c_wrk_move_alloc
subroutine c_wrk_cnv(wk,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: i
@@ -921,7 +801,7 @@ contains
function c_wrk_sizeof(wk) result(val)
use psb_realloc_mod
implicit none
implicit none
class(amg_cmlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
integer :: i
@@ -940,25 +820,5 @@ contains
end do
end if
end function c_wrk_sizeof
subroutine c_remap_data_clone(rmp, remap_out, info)
use psb_base_mod
implicit none
! Arguments
class(amg_c_remap_data_type), target, intent(inout) :: rmp
class(amg_c_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
if (info == psb_success_) &
& call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
remap_out%idest = rmp%idest
call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
end subroutine c_remap_data_clone
end module amg_c_onelev_mod
+66 -4
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -40,7 +40,7 @@
! Module: amg_c_prec_mod
!
! This module defines the user interfaces to the real/complex, single/double
! precision versions of the user-level AMG4PSBLAS routines.
! precision versions of the user-level MLD2P4 routines.
!
module amg_c_prec_mod
@@ -55,7 +55,12 @@ module amg_c_prec_mod
use amg_c_ainv_solver
use amg_c_invk_solver
use amg_c_invt_solver
use amg_c_krm_solver
interface amg_precset
module procedure amg_c_iprecsetsm, amg_c_iprecsetsv, &
& amg_c_cprecseti, amg_c_cprecsetc, amg_c_cprecsetr, &
& amg_c_iprecsetag
end interface amg_precset
interface amg_extprol_bld
subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
@@ -77,4 +82,61 @@ module amg_c_prec_mod
end subroutine amg_c_extprol_bld
end interface amg_extprol_bld
contains
subroutine amg_c_iprecsetsm(p,val,info,pos)
type(amg_cprec_type), intent(inout) :: p
class(amg_c_base_smoother_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(val,info,pos=pos)
end subroutine amg_c_iprecsetsm
subroutine amg_c_iprecsetsv(p,val,info,pos)
type(amg_cprec_type), intent(inout) :: p
class(amg_c_base_solver_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(val,info, pos=pos)
end subroutine amg_c_iprecsetsv
subroutine amg_c_iprecsetag(p,val,info,pos)
type(amg_cprec_type), intent(inout) :: p
class(amg_c_base_aggregator_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(val,info, pos=pos)
end subroutine amg_c_iprecsetag
subroutine amg_c_cprecseti(p,what,val,info,pos)
type(amg_cprec_type), intent(inout) :: p
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(what,val,info,pos=pos)
end subroutine amg_c_cprecseti
subroutine amg_c_cprecsetr(p,what,val,info,pos)
type(amg_cprec_type), intent(inout) :: p
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(what,val,info,pos=pos)
end subroutine amg_c_cprecsetr
subroutine amg_c_cprecsetc(p,what,val,info,pos)
type(amg_cprec_type), intent(inout) :: p
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(what,val,info,pos=pos)
end subroutine amg_c_cprecsetc
end module amg_c_prec_mod
+17 -35
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -66,7 +66,7 @@ module amg_c_prec_type
!
! This is the data type containing all the information about the multilevel
! preconditioner ('d', 's', 'c' and 'z', according to the real/complex,
! single/double precision version of AMG4PSBLAS).
! single/double precision version of MLD2P4).
! It consists of an array of 'one-level' intermediate data structures
! of type amg_conelev_type, each containing the information needed to apply
! the smoothing and the coarse-space correction at a generic level. RT is the
@@ -155,16 +155,13 @@ 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,iout,root)
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(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
@@ -427,22 +424,11 @@ contains
end if
end function amg_c_get_nzeros
function amg_cprec_sizeof(prec, global) result(val)
function amg_cprec_sizeof(prec) result(val)
implicit none
class(amg_cprec_type), intent(in) :: prec
logical, intent(in), optional :: global
integer(psb_epk_) :: val
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
type(psb_ctxt_type) :: ctxt
logical :: global_
if (present(global)) then
global_ = global
else
global_ = .false.
end if
val = 0
val = val + psb_sizeof_ip
if (allocated(prec%precv)) then
@@ -450,11 +436,6 @@ contains
val = val + prec%precv(i)%sizeof()
end do
end if
if (global_) then
ctxt = prec%ctxt
call psb_sum(ctxt,val)
end if
end function amg_cprec_sizeof
!
@@ -757,15 +738,16 @@ contains
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
integer(psb_ipk_) :: i, j, il1, iln, lev
type(psb_ctxt_type) :: ctxt
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np, iproc_
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_
info = 0
ctxt = prec%ctxt
call psb_info(ctxt,iam,np)
icontxt = prec%ctxt
call psb_info(icontxt,iam,np)
iln = size(prec%precv)
if (present(istart)) then
il1 = max(1,istart)
@@ -830,13 +812,13 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, ln, lev
type(psb_ctxt_type) :: ctxt
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np
info = psb_success_
select type(pout => precout)
class is (amg_cprec_type)
pout%ctxt = prec%ctxt
pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps
if (allocated(prec%precv)) then
@@ -852,8 +834,8 @@ contains
if (info == psb_success_) then
pout%precv(lev)%base_a => pout%precv(lev)%ac
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
end if
end do
end if
@@ -893,8 +875,8 @@ contains
do i=2, size(b%precv)
b%precv(i)%base_a => b%precv(i)%ac
b%precv(i)%base_desc => b%precv(i)%desc_ac
b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
end do
else
@@ -1,14 +1,11 @@
!
!
!
!
! 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
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
@@ -55,14 +52,14 @@
! 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
! 3. The name of the MLD2P4 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
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 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
@@ -73,16 +70,16 @@
!
!
!
! File: amg_c_krm_solver_mod.f90
! File: amg_c_rkr_solver_mod.f90
!
! Module: amg_c_krm_solver_mod
! Module: amg_c_rkr_solver_mod
!
module amg_c_krm_solver
module amg_c_rkr_solver
use amg_c_base_solver_mod
use amg_c_prec_type
type, extends(amg_c_base_solver_type) :: amg_c_krm_solver_type
type, extends(amg_c_base_solver_type) :: amg_c_rkr_solver_type
!
logical :: global
character(len=16) :: method, kprec, sub_solve
@@ -97,46 +94,46 @@ module amg_c_krm_solver
contains
!
!
procedure, pass(sv) :: dump => c_krm_solver_dmp
procedure, pass(sv) :: check => c_krm_solver_check
procedure, pass(sv) :: clone => c_krm_solver_clone
procedure, pass(sv) :: clone_settings => c_krm_solver_clone_settings
procedure, pass(sv) :: cnv => c_krm_solver_cnv
procedure, pass(sv) :: apply_v => amg_c_krm_solver_apply_vect
procedure, pass(sv) :: apply_a => amg_c_krm_solver_apply
procedure, pass(sv) :: clear_data => c_krm_solver_clear_data
procedure, pass(sv) :: free => c_krm_solver_free
procedure, pass(sv) :: cseti => c_krm_solver_cseti
procedure, pass(sv) :: csetc => c_krm_solver_csetc
procedure, pass(sv) :: csetr => c_krm_solver_csetr
procedure, pass(sv) :: sizeof => c_krm_solver_sizeof
procedure, pass(sv) :: get_nzeros => c_krm_solver_get_nzeros
!procedure, nopass :: get_id => c_krm_solver_get_id
procedure, pass(sv) :: is_global => c_krm_solver_is_global
procedure, nopass :: is_iterative => c_krm_solver_is_iterative
procedure, pass(sv) :: dump => c_rkr_solver_dmp
procedure, pass(sv) :: check => c_rkr_solver_check
procedure, pass(sv) :: clone => c_rkr_solver_clone
procedure, pass(sv) :: clone_settings => c_rkr_solver_clone_settings
procedure, pass(sv) :: cnv => c_rkr_solver_cnv
procedure, pass(sv) :: apply_v => amg_c_rkr_solver_apply_vect
procedure, pass(sv) :: apply_a => amg_c_rkr_solver_apply
procedure, pass(sv) :: clear_data => c_rkr_solver_clear_data
procedure, pass(sv) :: free => c_rkr_solver_free
procedure, pass(sv) :: cseti => c_rkr_solver_cseti
procedure, pass(sv) :: csetc => c_rkr_solver_csetc
procedure, pass(sv) :: csetr => c_rkr_solver_csetr
procedure, pass(sv) :: sizeof => c_rkr_solver_sizeof
procedure, pass(sv) :: get_nzeros => c_rkr_solver_get_nzeros
!procedure, nopass :: get_id => c_rkr_solver_get_id
procedure, pass(sv) :: is_global => c_rkr_solver_is_global
procedure, nopass :: is_iterative => c_rkr_solver_is_iterative
!
! These methods are specific for the new solver type
! and therefore need to be overridden
!
procedure, pass(sv) :: descr => c_krm_solver_descr
procedure, pass(sv) :: default => c_krm_solver_default
procedure, pass(sv) :: build => amg_c_krm_solver_bld
procedure, nopass :: get_fmt => c_krm_solver_get_fmt
end type amg_c_krm_solver_type
procedure, pass(sv) :: descr => c_rkr_solver_descr
procedure, pass(sv) :: default => c_rkr_solver_default
procedure, pass(sv) :: build => amg_c_rkr_solver_bld
procedure, nopass :: get_fmt => c_rkr_solver_get_fmt
end type amg_c_rkr_solver_type
private :: c_krm_solver_get_fmt, c_krm_solver_descr, c_krm_solver_default
private :: c_rkr_solver_get_fmt, c_rkr_solver_descr, c_rkr_solver_default
interface
subroutine amg_c_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
subroutine amg_c_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,wv,info,init,initu)
import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
import :: psb_desc_type, amg_c_rkr_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_krm_solver_type), intent(inout) :: sv
class(amg_c_rkr_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
@@ -146,17 +143,17 @@ module amg_c_krm_solver
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu
end subroutine amg_c_krm_solver_apply_vect
end subroutine amg_c_rkr_solver_apply_vect
end interface
interface
subroutine amg_c_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
subroutine amg_c_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
import :: psb_desc_type, amg_c_rkr_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_krm_solver_type), intent(inout) :: sv
class(amg_c_rkr_solver_type), intent(inout) :: sv
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta
@@ -165,24 +162,24 @@ module amg_c_krm_solver
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
complex(psb_spk_),intent(inout), optional :: initu(:)
end subroutine amg_c_krm_solver_apply
end subroutine amg_c_rkr_solver_apply
end interface
interface
subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
subroutine amg_c_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_c_rkr_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_krm_solver_type), intent(inout) :: sv
class(amg_c_rkr_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_krm_solver_bld
end subroutine amg_c_rkr_solver_bld
end interface
@@ -190,12 +187,12 @@ contains
!
!
subroutine c_krm_solver_default(sv)
subroutine c_rkr_solver_default(sv)
Implicit None
! Arguments
class(amg_c_krm_solver_type), intent(inout) :: sv
class(amg_c_rkr_solver_type), intent(inout) :: sv
sv%method = 'bicgstab'
sv%kprec = 'bjac'
@@ -210,42 +207,42 @@ contains
sv%global = .false.
return
end subroutine c_krm_solver_default
end subroutine c_rkr_solver_default
function c_krm_solver_get_nzeros(sv) result(val)
function c_rkr_solver_get_nzeros(sv) result(val)
implicit none
! Arguments
class(amg_c_krm_solver_type), intent(in) :: sv
class(amg_c_rkr_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
val = sv%prec%get_nzeros()
return
end function c_krm_solver_get_nzeros
end function c_rkr_solver_get_nzeros
function c_krm_solver_sizeof(sv) result(val)
function c_rkr_solver_sizeof(sv) result(val)
implicit none
! Arguments
class(amg_c_krm_solver_type), intent(in) :: sv
class(amg_c_rkr_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
return
end function c_krm_solver_sizeof
end function c_rkr_solver_sizeof
subroutine c_krm_solver_check(sv,info)
subroutine c_rkr_solver_check(sv,info)
Implicit None
! Arguments
class(amg_c_krm_solver_type), intent(inout) :: sv
class(amg_c_rkr_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_krm_solver_check'
character(len=20) :: name='c_rkr_solver_check'
call psb_erractionsave(err_act)
info = psb_success_
@@ -259,36 +256,36 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine c_krm_solver_check
end subroutine c_rkr_solver_check
subroutine c_krm_solver_cseti(sv,what,val,info,idx)
subroutine c_rkr_solver_cseti(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_c_krm_solver_type), intent(inout) :: sv
class(amg_c_rkr_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_krm_solver_cseti'
character(len=20) :: name='c_rkr_solver_cseti'
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(trim(what)))
case('KRM_IRST')
case('RKR_IRST')
sv%irst = val
case('KRM_ISTOPC')
case('RKR_ISTOPC')
sv%istopc = val
case('KRM_ITMAX')
case('RKR_ITMAX')
sv%itmax = val
case('KRM_ITRACE')
case('RKR_ITRACE')
sv%itrace = val
case('KRM_SUB_SOLVE')
case('RKR_SUB_SOLVE')
sv%i_sub_solve = val
case('KRM_FILLIN')
case('RKR_FILLIN')
sv%fillin = val
case default
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
@@ -299,33 +296,33 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine c_krm_solver_cseti
end subroutine c_rkr_solver_cseti
subroutine c_krm_solver_csetc(sv,what,val,info,idx)
subroutine c_rkr_solver_csetc(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_c_krm_solver_type), intent(inout) :: sv
class(amg_c_rkr_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_krm_solver_csetc'
character(len=20) :: name='c_rkr_solver_csetc'
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(trim(what)))
case('KRM_METHOD')
case('RKR_METHOD')
sv%method = psb_toupper(trim(val))
case('KRM_KPREC')
case('RKR_KPREC')
sv%kprec = psb_toupper(trim(val))
case('KRM_SUB_SOLVE')
case('RKR_SUB_SOLVE')
sv%sub_solve = psb_toupper(trim(val))
case('KRM_GLOBAL')
case('RKR_GLOBAL')
select case(psb_toupper(trim(val)))
case('LOCAL','FALSE')
sv%global = .false.
@@ -348,26 +345,26 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine c_krm_solver_csetc
end subroutine c_rkr_solver_csetc
subroutine c_krm_solver_csetr(sv,what,val,info,idx)
subroutine c_rkr_solver_csetr(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_c_krm_solver_type), intent(inout) :: sv
class(amg_c_rkr_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_krm_solver_csetr'
character(len=20) :: name='c_rkr_solver_csetr'
call psb_erractionsave(err_act)
info = psb_success_
select case(psb_toupper(what))
case('KRM_EPS')
case('RKR_EPS')
sv%eps = val
case default
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
@@ -378,18 +375,18 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine c_krm_solver_csetr
end subroutine c_rkr_solver_csetr
subroutine c_krm_solver_clear_data(sv,info)
subroutine c_rkr_solver_clear_data(sv,info)
use psb_base_mod, only : psb_exit
Implicit None
! Arguments
class(amg_c_krm_solver_type), intent(inout) :: sv
class(amg_c_rkr_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: l_ctxt
character(len=20) :: name='c_krm_solver_free'
character(len=20) :: name='c_rkr_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
@@ -406,19 +403,19 @@ contains
nullify(sv%a)
call psb_erractionrestore(err_act)
return
end subroutine c_krm_solver_clear_data
end subroutine c_rkr_solver_clear_data
subroutine c_krm_solver_free(sv,info)
subroutine c_rkr_solver_free(sv,info)
use psb_base_mod, only : psb_exit
Implicit None
! Arguments
class(amg_c_krm_solver_type), intent(inout) :: sv
class(amg_c_rkr_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: l_ctxt
character(len=20) :: name='c_krm_solver_free'
character(len=20) :: name='c_rkr_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
@@ -427,31 +424,29 @@ contains
call psb_erractionrestore(err_act)
return
end subroutine c_krm_solver_free
end subroutine c_rkr_solver_free
function c_krm_solver_get_fmt() result(val)
function c_rkr_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "KRM solver"
end function c_krm_solver_get_fmt
val = "RKR solver"
end function c_rkr_solver_get_fmt
subroutine c_krm_solver_descr(sv,info,iout,coarse,prefix)
subroutine c_rkr_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_c_krm_solver_type), intent(in) :: sv
class(amg_c_rkr_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'
character(len=20), parameter :: name='amg_c_rkr_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -460,33 +455,34 @@ 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_,*) ' Recursive Krylov solver (global)'
else
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
write(iout_,*) ' Recursive Krylov solver (local) '
end if
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(iout_,info,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
9999 call psb_error_handler(err_act)
return
end subroutine c_krm_solver_descr
end subroutine c_rkr_solver_descr
subroutine c_krm_solver_cnv(sv,info,amold,vmold,imold)
subroutine c_rkr_solver_cnv(sv,info,amold,vmold,imold)
implicit none
class(amg_c_krm_solver_type), intent(inout) :: sv
class(amg_c_rkr_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
@@ -494,13 +490,13 @@ contains
call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
end subroutine c_krm_solver_cnv
end subroutine c_rkr_solver_cnv
subroutine c_krm_solver_clone(sv,svout,info)
subroutine c_rkr_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(amg_c_krm_solver_type), intent(inout) :: sv
class(amg_c_rkr_solver_type), intent(inout) :: sv
class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
@@ -509,7 +505,7 @@ contains
call svout%free(info)
allocate(svout,stat=info,mold=sv)
select type(so=>svout)
class is(amg_c_krm_solver_type)
class is(amg_c_rkr_solver_type)
so%method = sv%method
so%kprec = sv%kprec
so%sub_solve = sv%sub_solve
@@ -528,21 +524,21 @@ contains
info = psb_err_internal_error_
end select
end subroutine c_krm_solver_clone
end subroutine c_rkr_solver_clone
subroutine c_krm_solver_clone_settings(sv,svout,info)
subroutine c_rkr_solver_clone_settings(sv,svout,info)
Implicit None
! Arguments
class(amg_c_krm_solver_type), intent(inout) :: sv
class(amg_c_rkr_solver_type), intent(inout) :: sv
class(amg_c_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
info = psb_success_
select type(so=>svout)
class is(amg_c_krm_solver_type)
class is(amg_c_rkr_solver_type)
so%method = sv%method
so%kprec = sv%kprec
so%sub_solve = sv%sub_solve
@@ -558,11 +554,11 @@ contains
info = psb_err_internal_error_
end select
end subroutine c_krm_solver_clone_settings
end subroutine c_rkr_solver_clone_settings
subroutine c_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
subroutine c_rkr_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
implicit none
class(amg_c_krm_solver_type), intent(in) :: sv
class(amg_c_rkr_solver_type), intent(in) :: sv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
@@ -572,23 +568,23 @@ contains
call sv%prec%dump(info,prefix=prefix,head=head)
end subroutine c_krm_solver_dmp
end subroutine c_rkr_solver_dmp
!
! Notify whether KRM is used as a global solver
! Notify whether RKR is used as a global solver
!
function c_krm_solver_is_global(sv) result(val)
function c_rkr_solver_is_global(sv) result(val)
implicit none
class(amg_c_krm_solver_type), intent(in) :: sv
class(amg_c_rkr_solver_type), intent(in) :: sv
logical :: val
val = (sv%global)
end function c_krm_solver_is_global
end function c_rkr_solver_is_global
!
function c_krm_solver_is_iterative() result(val)
function c_rkr_solver_is_iterative() result(val)
implicit none
logical :: val
val = .true.
end function c_krm_solver_is_iterative
end function c_rkr_solver_is_iterative
end module amg_c_krm_solver
end module amg_c_rkr_solver
+7 -14
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+6 -15
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+48 -50
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
@@ -61,9 +58,10 @@ module amg_d_ainv_solver
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
!!$ procedure, pass(sv) :: seti => amg_d_ainv_solver_seti
!!$ procedure, pass(sv) :: setc => amg_d_ainv_solver_setc
!!$ procedure, pass(sv) :: setr => amg_d_ainv_solver_setr
procedure, pass(sv) :: seti => amg_d_ainv_solver_seti
procedure, pass(sv) :: setc => amg_d_ainv_solver_setc
procedure, pass(sv) :: setr => amg_d_ainv_solver_setr
generic, public :: set => seti, setr, setc
procedure, pass(sv) :: descr => amg_d_ainv_solver_descr
procedure, pass(sv) :: default => d_ainv_solver_default
procedure, nopass :: stringval => d_ainv_stringval
@@ -161,44 +159,44 @@ module amg_d_ainv_solver
end subroutine amg_d_ainv_solver_csetr
end interface
!!$ interface
!!$ subroutine amg_d_ainv_solver_setc(sv,what,val,info)
!!$ import :: amg_d_ainv_solver_type, psb_ipk_
!!$ Implicit none
!!$ ! Arguments
!!$ class(amg_d_ainv_solver_type), intent(inout) :: sv
!!$ integer(psb_ipk_), intent(in) :: what
!!$ character(len=*), intent(in) :: val
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_d_ainv_solver_setc
!!$ end interface
!!$
!!$ interface
!!$ subroutine amg_d_ainv_solver_seti(sv,what,val,info)
!!$ import :: amg_d_ainv_solver_type, psb_ipk_
!!$ Implicit none
!!$ ! Arguments
!!$ class(amg_d_ainv_solver_type), intent(inout) :: sv
!!$ integer(psb_ipk_), intent(in) :: what
!!$ integer(psb_ipk_), intent(in) :: val
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_d_ainv_solver_seti
!!$ end interface
!!$
!!$ interface
!!$ subroutine amg_d_ainv_solver_setr(sv,what,val,info)
!!$ import :: amg_d_ainv_solver_type, psb_ipk_, psb_dpk_
!!$ Implicit none
!!$ ! Arguments
!!$ class(amg_d_ainv_solver_type), intent(inout) :: sv
!!$ integer(psb_ipk_), intent(in) :: what
!!$ real(psb_dpk_), intent(in) :: val
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_d_ainv_solver_setr
!!$ end interface
interface
subroutine amg_d_ainv_solver_setc(sv,what,val,info)
import :: amg_d_ainv_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_d_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_ainv_solver_setc
end interface
interface
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_d_ainv_solver_seti(sv,what,val,info)
import :: amg_d_ainv_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_d_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_ainv_solver_seti
end interface
interface
subroutine amg_d_ainv_solver_setr(sv,what,val,info)
import :: amg_d_ainv_solver_type, psb_ipk_, psb_dpk_
Implicit none
! Arguments
class(amg_d_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_ainv_solver_setr
end interface
interface
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
Implicit None
@@ -208,7 +206,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
+11 -18
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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)
+7 -14
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -126,7 +126,7 @@ module amg_d_base_aggregator_mod
& psb_d_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
implicit none
type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
type(psb_desc_type), intent(inout) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: nlaggr(:)
type(amg_dml_parms), intent(inout) :: parms
type(psb_d_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -144,7 +144,7 @@ module amg_d_base_aggregator_mod
& psb_d_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
implicit none
type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
type(psb_desc_type), intent(inout) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: nlaggr(:)
type(amg_dml_parms), intent(inout) :: parms
type(psb_d_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -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
+7 -10
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
+3 -4
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+4 -4
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+6 -13
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+8 -22
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+14 -28
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+1 -1
View File
@@ -2,7 +2,7 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
+5 -12
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+2 -2
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
+9 -16
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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)
+3 -3
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -39,7 +39,7 @@
!
! Module: amg_inner_mod
!
! This module defines the interfaces to inner AMG4PSBLAS routines.
! This module defines the interfaces to inner MLD2P4 routines.
! The interfaces of the user level routines are defined in amg_prec_mod.f90.
!
module amg_d_inner_mod
+23 -12
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
@@ -54,6 +51,8 @@ module amg_d_invk_solver
procedure, pass(sv) :: clone => amg_d_invk_solver_clone
procedure, pass(sv) :: build => amg_d_invk_solver_bld
procedure, pass(sv) :: cseti => amg_d_invk_solver_cseti
procedure, pass(sv) :: seti => amg_d_invk_solver_seti
generic, public :: set => seti
procedure, pass(sv) :: descr => amg_d_invk_solver_descr
procedure, pass(sv) :: default => d_invk_solver_default
end type amg_d_invk_solver_type
@@ -123,7 +122,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
@@ -133,10 +132,22 @@ 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
interface
subroutine amg_d_invk_solver_seti(sv,what,val,info)
import :: amg_d_invk_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_d_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_invk_solver_seti
end interface
contains
subroutine d_invk_solver_default(sv)
+38 -15
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
@@ -55,6 +52,9 @@ module amg_d_invt_solver
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
procedure, pass(sv) :: seti => amg_d_invt_solver_seti
procedure, pass(sv) :: setr => amg_d_invt_solver_setr
generic, public :: set => seti, setr
procedure, pass(sv) :: descr => amg_d_invt_solver_descr
procedure, pass(sv) :: default => d_invt_solver_default
end type amg_d_invt_solver_type
@@ -134,21 +134,44 @@ 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
interface
subroutine amg_d_invt_solver_setr(sv,what,val,info)
import :: amg_d_invt_solver_type, psb_dpk_, psb_ipk_
Implicit none
! Arguments
class(amg_d_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_invt_solver_setr
end interface
interface
subroutine amg_d_invt_solver_seti(sv,what,val,info)
import :: amg_d_invt_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_d_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine
end interface
contains
subroutine d_invt_solver_default(sv)
+8 -10
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
File diff suppressed because it is too large Load Diff
+8 -15
View File
@@ -3,9 +3,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -313,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_
@@ -339,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
+164 -305
View File
@@ -1,15 +1,15 @@
!
!
!
!
! 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
!
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
! 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:
@@ -21,7 +21,7 @@
! 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
@@ -33,22 +33,22 @@
! 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_onelev_mod.f90
!
! Module: amg_d_onelev_mod
!
! This module defines:
! This module defines:
! - the amg_d_onelev_type data structure containing one level
! of a multilevel preconditioner and related
! data structures;
!
! It contains routines for
! - Building and applying;
! - Building and applying;
! - checking if the preconditioner is correctly defined;
! - printing a description of the preconditioner;
! - deallocating the preconditioner data structure.
! - deallocating the preconditioner data structure.
!
module amg_d_onelev_mod
@@ -56,8 +56,6 @@ module amg_d_onelev_mod
use amg_base_prec_type
use amg_d_base_smoother_mod
use amg_d_dec_aggregator_mod
use amg_d_parmatch_aggregator_mod
use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, &
& psb_d_base_vect_type, psb_ldspmat_type, psb_dlinmap_type, psb_dpk_, &
& psb_ipk_, psb_epk_, psb_lpk_, psb_desc_type, psb_i_base_vect_type, &
@@ -75,16 +73,16 @@ module amg_d_onelev_mod
! class(amg_d_base_smoother_type), pointer :: sm2 => null()
! class(amg_dmlprec_wrk_type), allocatable :: wrk
! class(amg_d_base_aggregator_type), allocatable :: aggr
! type(amg_dml_parms) :: parms
! type(amg_dml_parms) :: parms
! type(psb_dspmat_type) :: ac
! type(psb_desc_type) :: desc_ac
! type(psb_dspmat_type), pointer :: base_a => null()
! type(psb_desc_type), pointer :: base_desc => null()
! type(psb_dspmat_type), pointer :: base_a => null()
! type(psb_desc_type), pointer :: base_desc => null()
! type(psb_dlinmap_type) :: map
! end type amg_donelev_type
!
! Note that d denotes the kind of the real data type to be chosen
! according to single/double precision version of AMG4PSBLAS.
! according to single/double precision version of MLD2P4.
!
! sm,sm2a - class(amg_d_base_smoother_type), allocatable
! The current level pre- and post-smooother.
@@ -95,7 +93,7 @@ module amg_d_onelev_mod
! Workspace for application of preconditioner; may be
! pre-allocated to save time in the application within a
! Krylov solver.
! aggr - class(amg_d_base_aggregator_type), allocatable
! aggr - class(amg_d_base_aggregator_type), allocatable
! The aggregator object: holds the algorithmic choices and
! (possibly) additional data for building the aggregation.
! parms - type(amg_dml_parms)
@@ -106,7 +104,7 @@ module amg_d_onelev_mod
! The communication descriptor associated to the matrix
! stored in ac.
! base_a - type(psb_dspmat_type), pointer.
! Pointer (really a pointer!) to the local part of the current
! Pointer (really a pointer!) to the local part of the current
! matrix (so we have a unified treatment of residuals).
! We need this to avoid passing explicitly the current matrix
! to the routine which applies the preconditioner.
@@ -117,13 +115,13 @@ module amg_d_onelev_mod
! vector spaces associated to the index spaces of the previous
! and current levels.
!
! Methods:
! Methods:
! Most methods follow the encapsulation hierarchy: they take whatever action
! is appropriate for the current object, then call the corresponding method for
! the contained object.
! As an example: the descr() method prints out a description of the
! level. It starts by invoking the descr() method of the parms object,
! then calls the descr() method of the smoother object.
! then calls the descr() method of the smoother object.
!
! descr - Prints a description of the object.
! default - Set default values
@@ -132,14 +130,14 @@ module amg_d_onelev_mod
! it is passed to the smoother object for further processing.
! check - Sanity checks.
! sizeof - Total memory occupation in bytes
! get_nzeros - Number of nonzeros
! get_nzeros - Number of nonzeros
! get_wrksz - How many workspace vector does apply_vect need
! allocate_wrk - Allocate auxiliary workspace
! free_wrk - Free auxiliary workspace
! bld_tprol - Invoke the aggr method to build the tentative prolongator
! mat_asb - Build the final (possibly smoothed) prolongator and coarse matrix.
!
! mat_asb - Build the final (possibly smoothed) prolongator and coarse matrix.
!
!
type amg_dmlprec_wrk_type
real(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
type(psb_d_vect_type) :: vtx, vty, vx2l, vy2l
@@ -150,35 +148,25 @@ module amg_d_onelev_mod
procedure, pass(wk) :: clone => d_wrk_clone
procedure, pass(wk) :: move_alloc => d_wrk_move_alloc
procedure, pass(wk) :: cnv => d_wrk_cnv
procedure, pass(wk) :: sizeof => d_wrk_sizeof
procedure, pass(wk) :: sizeof => d_wrk_sizeof
end type amg_dmlprec_wrk_type
private :: d_wrk_alloc, d_wrk_free, &
& d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv, d_wrk_sizeof
type amg_d_remap_data_type
type(psb_dspmat_type) :: ac_pre_remap
type(psb_desc_type) :: desc_ac_pre_remap
integer(psb_ipk_) :: idest
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
contains
procedure, pass(rmp) :: clone => d_remap_data_clone
end type amg_d_remap_data_type
& d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv, d_wrk_sizeof
type amg_d_onelev_type
class(amg_d_base_smoother_type), allocatable :: sm, sm2a
class(amg_d_base_smoother_type), pointer :: sm2 => null()
class(amg_dmlprec_wrk_type), allocatable :: wrk
class(amg_d_base_aggregator_type), allocatable :: aggr
type(amg_dml_parms) :: parms
type(amg_dml_parms) :: parms
type(psb_dspmat_type) :: ac
integer(psb_ipk_) :: ac_nz_loc
integer(psb_lpk_) :: ac_nz_tot
type(psb_desc_type) :: desc_ac
type(psb_dspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_dspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_ldspmat_type) :: tprol
type(psb_dlinmap_type) :: linmap
type(amg_d_remap_data_type) :: remap_data
type(psb_dlinmap_type) :: map
real(psb_dpk_) :: szratio
contains
procedure, pass(lv) :: bld_tprol => d_base_onelev_bld_tprol
@@ -199,7 +187,7 @@ module amg_d_onelev_mod
procedure, pass(lv) :: setsm => amg_d_base_onelev_setsm
procedure, pass(lv) :: setsv => amg_d_base_onelev_setsv
procedure, pass(lv) :: setag => amg_d_base_onelev_setag
generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag
generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag
procedure, pass(lv) :: sizeof => d_base_onelev_sizeof
procedure, pass(lv) :: get_nzeros => d_base_onelev_get_nzeros
procedure, pass(lv) :: get_wrksz => d_base_onelev_get_wrksize
@@ -207,14 +195,7 @@ module amg_d_onelev_mod
procedure, pass(lv) :: free_wrk => d_base_onelev_free_wrk
procedure, nopass :: stringval => amg_stringval
procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc
procedure, pass(lv) :: map_rstr_a => amg_d_base_onelev_map_rstr_a
procedure, pass(lv) :: map_prol_a => amg_d_base_onelev_map_prol_a
procedure, pass(lv) :: map_rstr_v => amg_d_base_onelev_map_rstr_v
procedure, pass(lv) :: map_prol_v => amg_d_base_onelev_map_prol_v
generic, public :: map_rstr => map_rstr_a, map_rstr_v
generic, public :: map_prol => map_prol_a, map_prol_v
end type amg_d_onelev_type
type amg_d_onelev_node
@@ -228,11 +209,11 @@ module amg_d_onelev_mod
& d_base_onelev_get_wrksize, d_base_onelev_allocate_wrk, &
& d_base_onelev_free_wrk
interface
interface
subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_, psb_ldspmat_type, psb_lpk_
import :: amg_d_onelev_type
implicit none
implicit none
class(amg_d_onelev_type), intent(inout), target :: lv
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a
@@ -257,143 +238,141 @@ module amg_d_onelev_mod
end subroutine amg_d_base_onelev_build
end interface
interface
subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
interface
subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_d_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
class(amg_d_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
end subroutine amg_d_base_onelev_descr
end interface
interface
interface
subroutine amg_d_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_d_onelev_type, psb_d_base_vect_type, psb_dpk_, &
& psb_d_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
! Arguments
class(amg_d_onelev_type), intent(inout) :: lv
class(amg_d_onelev_type), intent(inout) :: lv
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_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, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none
implicit none
class(amg_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_base_onelev_free
end interface
interface
interface
subroutine amg_d_base_onelev_check(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
! Arguments
class(amg_d_onelev_type), intent(inout) :: lv
class(amg_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_base_onelev_check
end interface
interface
interface
subroutine amg_d_base_onelev_setsm(lv,val,info,pos)
import :: psb_dpk_, amg_d_onelev_type, amg_d_base_smoother_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_base_smoother_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine amg_d_base_onelev_setsm
end interface
interface
interface
subroutine amg_d_base_onelev_setsv(lv,val,info,pos)
import :: psb_dpk_, amg_d_onelev_type, amg_d_base_solver_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_base_solver_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine amg_d_base_onelev_setsv
end interface
interface
interface
subroutine amg_d_base_onelev_setag(lv,val,info,pos)
import :: psb_dpk_, amg_d_onelev_type, amg_d_base_aggregator_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_base_aggregator_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine amg_d_base_onelev_setag
end interface
interface
interface
subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
end subroutine amg_d_base_onelev_cseti
end interface
interface
interface
subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
end subroutine amg_d_base_onelev_csetc
end interface
interface
interface
subroutine amg_d_base_onelev_csetr(lv,what,val,info,pos,idx)
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
character(len=*), intent(in) :: what
class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
@@ -401,13 +380,13 @@ interface
end subroutine amg_d_base_onelev_csetr
end interface
interface
interface
subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
& solver,tprol,global_num)
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
implicit none
class(amg_d_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
@@ -415,62 +394,15 @@ interface
logical, optional, intent(in) :: ac, rp, smoother, solver, tprol, global_num
end subroutine amg_d_base_onelev_dump
end interface
interface
subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
import
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta
real(psb_dpk_), intent(inout) :: u(:)
real(psb_dpk_), intent(out) :: v(:)
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), optional :: work(:)
end subroutine amg_d_base_onelev_map_rstr_a
subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
import
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta
type(psb_d_vect_type), intent(inout) :: vect_u, vect_v
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), optional :: work(:)
type(psb_d_vect_type), optional, target, intent(inout) :: vtx,vty
end subroutine amg_d_base_onelev_map_rstr_v
end interface
interface
subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
import
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta
real(psb_dpk_), intent(inout) :: u(:)
real(psb_dpk_), intent(out) :: v(:)
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), optional :: work(:)
end subroutine amg_d_base_onelev_map_prol_a
subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
import
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta
type(psb_d_vect_type), intent(inout) :: vect_u, vect_v
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), optional :: work(:)
type(psb_d_vect_type), optional, target, intent(inout) :: vtx,vty
end subroutine amg_d_base_onelev_map_prol_v
end interface
contains
!
! Function returning the size of the amg_prec_type data structure
! in bytes or in number of nonzeros of the operator(s) involved.
! in bytes or in number of nonzeros of the operator(s) involved.
!
function d_base_onelev_get_nzeros(lv) result(val)
implicit none
implicit none
class(amg_d_onelev_type), intent(in) :: lv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
@@ -482,16 +414,16 @@ contains
end function d_base_onelev_get_nzeros
function d_base_onelev_sizeof(lv) result(val)
implicit none
implicit none
class(amg_d_onelev_type), intent(in) :: lv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = psb_sizeof_ip+psb_sizeof_lp
val = val + lv%desc_ac%sizeof()
val = val + lv%ac%sizeof()
val = val + lv%tprol%sizeof()
val = val + lv%linmap%sizeof()
val = val + lv%map%sizeof()
if (allocated(lv%sm)) val = val + lv%sm%sizeof()
if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -500,19 +432,19 @@ contains
subroutine d_base_onelev_nullify(lv)
implicit none
implicit none
class(amg_d_onelev_type), intent(inout) :: lv
nullify(lv%base_a)
nullify(lv%base_desc)
nullify(lv%base_a)
nullify(lv%base_desc)
nullify(lv%sm2)
end subroutine d_base_onelev_nullify
!
! Multilevel defaults:
! Multilevel defaults:
! multiplicative vs. additive ML framework;
! Smoothed decoupled aggregation with zero threshold;
! Smoothed decoupled aggregation with zero threshold;
! distributed coarse matrix;
! damping omega computed with the max-norm estimate of the
! dominant eigenvalue;
@@ -522,10 +454,10 @@ contains
subroutine d_base_onelev_default(lv)
Implicit None
! Arguments
class(amg_d_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_) :: info
integer(psb_ipk_) :: info
lv%parms%sweeps_pre = 1
lv%parms%sweeps_post = 1
@@ -540,7 +472,7 @@ contains
lv%parms%aggr_filter = amg_no_filter_mat_
lv%parms%aggr_omega_val = dzero
lv%parms%aggr_thresh = 0.01_psb_dpk_
if (allocated(lv%sm)) call lv%sm%default()
if (allocated(lv%sm2a)) then
call lv%sm2a%default()
@@ -550,7 +482,7 @@ contains
end if
if (.not.allocated(lv%aggr)) allocate(amg_d_dec_aggregator_type :: lv%aggr,stat=info)
if (allocated(lv%aggr)) call lv%aggr%default()
return
end subroutine d_base_onelev_default
@@ -565,9 +497,9 @@ contains
type(psb_ldspmat_type), intent(out) :: t_prol
type(amg_daggr_data), intent(in) :: ag_data
integer(psb_ipk_), intent(out) :: info
call lv%aggr%bld_tprol(lv%parms,ag_data,a,desc_a,ilaggr,nlaggr,t_prol,info)
end subroutine d_base_onelev_bld_tprol
@@ -577,7 +509,7 @@ contains
integer(psb_ipk_), intent(out) :: info
call lv%aggr%update_next(lvnext%aggr,info)
end subroutine d_base_onelev_update_aggr
@@ -586,33 +518,33 @@ contains
Implicit None
! Arguments
class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_onelev_type), target, intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (allocated(lv%sm)) then
if (allocated(lv%sm)) then
call lv%sm%clone(lvout%sm,info)
else
if (allocated(lvout%sm)) then
else
if (allocated(lvout%sm)) then
call lvout%sm%free(info)
if (info==psb_success_) deallocate(lvout%sm,stat=info)
end if
end if
if (allocated(lv%sm2a)) then
if (allocated(lv%sm2a)) then
call lv%sm%clone(lvout%sm2a,info)
lvout%sm2 => lvout%sm2a
else
if (allocated(lvout%sm2a)) then
else
if (allocated(lvout%sm2a)) then
call lvout%sm2a%free(info)
if (info==psb_success_) deallocate(lvout%sm2a,stat=info)
end if
lvout%sm2 => lvout%sm
end if
if (allocated(lv%aggr)) then
if (allocated(lv%aggr)) then
call lv%aggr%clone(lvout%aggr,info)
else
if (allocated(lvout%aggr)) then
if (allocated(lvout%aggr)) then
call lvout%aggr%free(info)
if (info==psb_success_) deallocate(lvout%aggr,stat=info)
end if
@@ -621,11 +553,10 @@ contains
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
if (info == psb_success_) call lv%map%clone(lvout%map,info)
lvout%base_a => lv%base_a
lvout%base_desc => lv%base_desc
return
end subroutine d_base_onelev_clone
@@ -634,12 +565,12 @@ contains
use psb_base_mod
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call b%free(info)
b%parms = lv%parms
b%szratio = lv%szratio
if (associated(lv%sm2,lv%sm2a)) then
if (associated(lv%sm2,lv%sm2a)) then
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm2a
@@ -650,18 +581,18 @@ contains
end if
call move_alloc(lv%aggr,b%aggr)
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
b%base_a => lv%base_a
b%base_desc => lv%base_desc
end subroutine d_base_onelev_move_alloc
function d_base_onelev_get_wrksize(lv) result(val)
implicit none
implicit none
class(amg_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_) :: val
@@ -682,54 +613,44 @@ contains
select case(lv%parms%ml_cycle)
case(amg_add_ml_,amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
! We're good
case(amg_kcycle_ml_, amg_kcyclesym_ml_)
!
! We need 7 in inneritkcycle.
! Can we reuse vtx?
!
! Can we reuse vtx?
!
val = val + 7
case default
! Need a better error signaling ?
val = -1
end select
end function d_base_onelev_get_wrksize
subroutine d_base_onelev_allocate_wrk(lv,info,vmold)
use psb_base_mod
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: nwv, i
info = psb_success_
nwv = lv%get_wrksz()
if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
if (info == 0) then
if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
!
! Need to fix this, we need two different allocations
!
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
& desc2=lv%remap_data%desc_ac_pre_remap)
else
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
end if
end if
if (info == 0) call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
end subroutine d_base_onelev_allocate_wrk
subroutine d_base_onelev_free_wrk(lv,info)
use psb_base_mod
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: nwv,i
integer(psb_ipk_) :: nwv,i
info = psb_success_
if (allocated(lv%wrk)) then
@@ -737,88 +658,46 @@ contains
if (info == 0) deallocate(lv%wrk,stat=info)
end if
end subroutine d_base_onelev_free_wrk
subroutine d_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
subroutine d_wrk_alloc(wk,nwv,desc,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
!
integer(psb_ipk_) :: i
info = psb_success_
call wk%free(info)
if (present(desc2)) then
!!$ write(0,*) 'Check on wrk_alloc 2',&
!!$ & desc2%get_local_rows(), desc%get_local_rows(),&
!!$ & desc2%get_local_cols(),desc%get_local_cols()
!!$ flush(0)
if (desc2%get_local_cols()>desc%get_local_cols()) then
call psb_geasb(wk%vx2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc2,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc2,info,&
& scratch=.true.,mold=vmold)
end do
else
!!$ write(0,*) 'Check on wrk_alloc 1.5 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
else
!!$ write(0,*) 'Check on wrk_alloc 1 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
end do
end subroutine d_wrk_alloc
subroutine d_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
@@ -839,7 +718,7 @@ contains
end if
end subroutine d_wrk_free
subroutine d_wrk_clone(wk,wkout,info)
use psb_base_mod
Implicit None
@@ -847,11 +726,11 @@ contains
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
class(amg_dmlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
@@ -873,12 +752,12 @@ contains
return
end subroutine d_wrk_clone
subroutine d_wrk_move_alloc(wk, b,info)
implicit none
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call b%free(info)
call move_alloc(wk%tx,b%tx)
call move_alloc(wk%ty,b%ty)
@@ -891,17 +770,17 @@ contains
call move_alloc(wk%vx2l%v,b%vx2l%v)
call move_alloc(wk%vy2l%v,b%vy2l%v)
call move_alloc(wk%wv,b%wv)
end subroutine d_wrk_move_alloc
subroutine d_wrk_cnv(wk,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: i
@@ -922,7 +801,7 @@ contains
function d_wrk_sizeof(wk) result(val)
use psb_realloc_mod
implicit none
implicit none
class(amg_dmlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
integer :: i
@@ -941,25 +820,5 @@ contains
end do
end if
end function d_wrk_sizeof
subroutine d_remap_data_clone(rmp, remap_out, info)
use psb_base_mod
implicit none
! Arguments
class(amg_d_remap_data_type), target, intent(inout) :: rmp
class(amg_d_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
if (info == psb_success_) &
& call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
remap_out%idest = rmp%idest
call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
end subroutine d_remap_data_clone
end module amg_d_onelev_mod
-689
View File
@@ -1,689 +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.
!
! moved here from amg4psblas-extension
!
!
! AMG4PSBLAS Extensions
!
! (C) Copyright 2019
!
! Salvatore Filippone Cranfield University
! Pasqua D'Ambra IAC-CNR, Naples, IT
!
! 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.
!
!
!
!
! The aggregator object hosts the aggregation method for building
! the multilevel hierarchy. This variant is based on the hybrid method
! presented in
!
!
! sm - class(amg_T_base_smoother_type), allocatable
! The current level preconditioner (aka smoother).
! parms - type(amg_RTml_parms)
! The parameters defining the multilevel strategy.
! ac - The local part of the current-level matrix, built by
! coarsening the previous-level matrix.
! desc_ac - type(psb_desc_type).
! The communication descriptor associated to the matrix
! stored in ac.
! base_a - type(psb_Tspmat_type), pointer.
! Pointer (really a pointer!) to the local part of the current
! matrix (so we have a unified treatment of residuals).
! We need this to avoid passing explicitly the current matrix
! to the routine which applies the preconditioner.
! base_desc - type(psb_desc_type), pointer.
! Pointer to the communication descriptor associated to the
! matrix pointed by base_a.
! map - Stores the maps (restriction and prolongation) between the
! vector spaces associated to the index spaces of the previous
! and current levels.
!
! Methods:
! Most methods follow the encapsulation hierarchy: they take whatever action
! is appropriate for the current object, then call the corresponding method for
! the contained object.
! As an example: the descr() method prints out a description of the
! level. It starts by invoking the descr() method of the parms object,
! then calls the descr() method of the smoother object.
!
! descr - Prints a description of the object.
! default - Set default values
! dump - Dump to file object contents
! set - Sets various parameters; when a request is unknown
! it is passed to the smoother object for further processing.
! check - Sanity checks.
! sizeof - Total memory occupation in bytes
! get_nzeros - Number of nonzeros
!
!
module amg_d_parmatch_aggregator_mod
use amg_d_base_aggregator_mod
use amg_d_matchboxp_mod
#if defined(SERIAL_MPI)
type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
end type amg_d_parmatch_aggregator_type
#else
type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
integer(psb_ipk_) :: matching_alg
integer(psb_ipk_) :: n_sweeps ! When n_sweeps >1 we need an auxiliary descriptor
integer(psb_ipk_) :: orig_aggr_size
integer(psb_ipk_) :: jacobi_sweeps
real(psb_dpk_), allocatable :: w(:), w_nxt(:)
type(psb_dspmat_type), allocatable :: prol, restr
type(psb_dspmat_type), allocatable :: ac, base_a, rwa
type(psb_desc_type), allocatable :: desc_ac, desc_ax, base_desc, rwdesc
logical :: reproducible_matching = .false.
logical :: need_symmetrize = .false.
logical :: unsmoothed_hierarchy = .true.
contains
procedure, pass(ag) :: bld_tprol => amg_d_parmatch_aggregator_build_tprol
procedure, pass(ag) :: mat_bld => amg_d_parmatch_aggregator_mat_bld
procedure, pass(ag) :: mat_asb => amg_d_parmatch_aggregator_mat_asb
procedure, pass(ag) :: inner_mat_asb => amg_d_parmatch_aggregator_inner_mat_asb
procedure, pass(ag) :: bld_map => amg_d_parmatch_aggregator_bld_map
procedure, pass(ag) :: csetc => amg_d_parmatch_aggr_csetc
procedure, pass(ag) :: cseti => amg_d_parmatch_aggr_cseti
procedure, pass(ag) :: default => amg_d_parmatch_aggr_set_default
procedure, pass(ag) :: sizeof => amg_d_parmatch_aggregator_sizeof
procedure, pass(ag) :: update_next => amg_d_parmatch_aggregator_update_next
procedure, pass(ag) :: bld_wnxt => amg_d_parmatch_bld_wnxt
procedure, pass(ag) :: bld_default_w => amg_d_bld_default_w
procedure, pass(ag) :: set_c_default_w => amg_d_set_prm_c_default_w
procedure, pass(ag) :: descr => amg_d_parmatch_aggregator_descr
procedure, pass(ag) :: clone => amg_d_parmatch_aggregator_clone
procedure, pass(ag) :: free => amg_d_parmatch_aggregator_free
procedure, nopass :: fmt => amg_d_parmatch_aggregator_fmt
procedure, nopass :: xt_desc => amg_d_parmatch_aggregator_xt_desc
end type amg_d_parmatch_aggregator_type
interface
subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,t_prol,info)
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
implicit none
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
type(amg_dml_parms), intent(inout) :: parms
type(amg_daggr_data), intent(in) :: ag_data
type(psb_dspmat_type), intent(inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
type(psb_ldspmat_type), intent(out) :: t_prol
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_parmatch_aggregator_build_tprol
end interface
interface
subroutine amg_d_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
implicit none
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
type(amg_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_ldspmat_type), intent(inout) :: t_prol
type(psb_dspmat_type), intent(out) :: op_prol,ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_parmatch_aggregator_mat_bld
end interface
interface
subroutine amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
& ac,desc_ac, op_prol,op_restr,info)
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
implicit none
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
type(amg_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a
type(psb_dspmat_type), intent(inout) :: op_prol,ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_parmatch_aggregator_mat_asb
end interface
interface
subroutine amg_d_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
& ac,desc_ac, op_prol,op_restr,info)
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
implicit none
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
type(amg_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_dspmat_type), intent(inout) :: op_prol,op_restr
type(psb_dspmat_type), intent(inout) :: ac
type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_parmatch_aggregator_inner_mat_asb
end interface
interface
subroutine amg_d_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
implicit none
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(amg_dml_parms), intent(inout) :: parms
type(psb_ldspmat_type), intent(inout) :: t_prol
type(psb_dspmat_type), intent(inout) :: ac, op_prol, op_restr
type(psb_desc_type), intent(out) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_parmatch_spmm_bld
end interface
interface
subroutine amg_d_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
implicit none
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(amg_dml_parms), intent(inout) :: parms
type(psb_ldspmat_type), intent(inout) :: t_prol
type(psb_dspmat_type), intent(inout) :: op_prol,ac, op_restr
type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_parmatch_unsmth_bld
end interface
interface
subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
implicit none
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(amg_dml_parms), intent(inout) :: parms
type(psb_ldspmat_type), intent(inout) :: t_prol
type(psb_dspmat_type), intent(inout) :: op_prol,ac, op_restr
type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_parmatch_smth_bld
end interface
interface
subroutine amg_d_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
implicit none
type(psb_dspmat_type), intent(inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(amg_dml_parms), intent(inout) :: parms
type(psb_ldspmat_type), intent(inout) :: t_prol
type(psb_dspmat_type), intent(inout) :: op_prol,ac, op_restr
type(psb_desc_type), intent(out) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_parmatch_spmm_bld_ov
end interface
interface
subroutine amg_d_parmatch_spmm_bld_inner(a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data,&
& psb_d_csr_sparse_mat, psb_ld_csr_sparse_mat
implicit none
type(psb_d_csr_sparse_mat), intent(inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(amg_dml_parms), intent(inout) :: parms
type(psb_ldspmat_type), intent(inout) :: t_prol
type(psb_dspmat_type), intent(inout) :: op_prol,ac, op_restr
type(psb_desc_type), intent(out) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_parmatch_spmm_bld_inner
end interface
private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels
contains
subroutine amg_d_bld_default_w(ag,nr)
use psb_realloc_mod
implicit none
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
integer(psb_ipk_), intent(in) :: nr
integer(psb_ipk_) :: info
call psb_realloc(nr,ag%w,info)
if (info /= psb_success_) return
ag%w = done
!call ag%set_c_default_w()
end subroutine amg_d_bld_default_w
subroutine amg_d_set_prm_c_default_w(ag)
use psb_realloc_mod
use iso_c_binding
implicit none
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
integer(psb_ipk_) :: info
!write(0,*) 'prm_c_deafult_w '
call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
end subroutine amg_d_set_prm_c_default_w
subroutine amg_d_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
use psb_realloc_mod
implicit none
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
integer(psb_lpk_), intent(in) :: ilaggr(:)
real(psb_dpk_), intent(in) :: valaggr(:)
integer(psb_ipk_), intent(in) :: nx
integer(psb_ipk_) :: info,i,j
! The vector was already fixed in the call to BCMatch.
!write(0,*) 'Executing bld_wnxt ',nx
call psb_realloc(nx,ag%w_nxt,info)
end subroutine amg_d_parmatch_bld_wnxt
function amg_d_parmatch_aggregator_fmt() result(val)
implicit none
character(len=32) :: val
val = "Parallel Matching aggregation"
end function amg_d_parmatch_aggregator_fmt
function amg_d_parmatch_aggregator_xt_desc() result(val)
implicit none
logical :: val
val = .true.
end function amg_d_parmatch_aggregator_xt_desc
function amg_d_parmatch_aggregator_sizeof(ag) result(val)
use psb_realloc_mod
implicit none
class(amg_d_parmatch_aggregator_type), intent(in) :: ag
integer(psb_epk_) :: val
val = 4
val = val + psb_size(ag%w) + psb_size(ag%w_nxt)
if (allocated(ag%ac)) val = val + ag%ac%sizeof()
if (allocated(ag%base_a)) val = val + ag%base_a%sizeof()
if (allocated(ag%prol)) val = val + ag%prol%sizeof()
if (allocated(ag%restr)) val = val + ag%restr%sizeof()
if (allocated(ag%desc_ac)) val = val + ag%desc_ac%sizeof()
if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
end function amg_d_parmatch_aggregator_sizeof
subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_d_parmatch_aggregator_type), intent(in) :: ag
type(amg_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps
write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_d_parmatch_aggregator_descr
function is_legal_malg(alg) result(val)
logical :: val
integer(psb_ipk_) :: alg
val = (0==alg)
end function is_legal_malg
function is_legal_csize(csize) result(val)
logical :: val
integer(psb_ipk_) :: csize
val = ((-1==csize).or.(csize >0))
end function is_legal_csize
function is_legal_nsweeps(nsw) result(val)
logical :: val
integer(psb_ipk_) :: nsw
val = (1<=nsw)
end function is_legal_nsweeps
function is_legal_nlevels(nlv) result(val)
logical :: val
integer(psb_ipk_) :: nlv
val = (1<=nlv)
end function is_legal_nlevels
subroutine amg_d_parmatch_aggregator_update_next(ag,agnext,info)
use psb_realloc_mod
implicit none
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
class(amg_d_base_aggregator_type), target, intent(inout) :: agnext
integer(psb_ipk_), intent(out) :: info
!
!
select type(agnext)
class is (amg_d_parmatch_aggregator_type)
if (.not.is_legal_malg(agnext%matching_alg)) &
& agnext%matching_alg = ag%matching_alg
if (.not.is_legal_nsweeps(agnext%n_sweeps))&
& agnext%n_sweeps = ag%n_sweeps
!!$ if (.not.is_legal_csize(agnext%max_csize))&
!!$ & agnext%max_csize = ag%max_csize
!!$ if (.not.is_legal_nlevels(agnext%max_nlevels))&
!!$ & agnext%max_nlevels = ag%max_nlevels
! Is this going to generate shallow copies/memory leaks/double frees?
! To be investigated further.
call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
call agnext%set_c_default_w()
if (ag%unsmoothed_hierarchy) then
agnext%unsmoothed_hierarchy = .true.
call move_alloc(ag%rwdesc,agnext%base_desc)
call move_alloc(ag%rwa,agnext%base_a)
end if
class default
! What should we do here?
end select
info = 0
end subroutine amg_d_parmatch_aggregator_update_next
subroutine amg_d_parmatch_aggr_csetc(ag,what,val,info,idx)
Implicit None
! Arguments
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, iwhat
character(len=20) :: name='d_parmatch_aggr_cseti'
info = psb_success_
! For now we ignore IDX
select case(psb_toupper(trim(what)))
case('PRMC_REPRODUCIBLE_MATCHING')
select case(psb_toupper(trim(val)))
case('F','FALSE')
ag%reproducible_matching = .false.
case('REPRODUCIBLE','TRUE','T')
ag%reproducible_matching =.true.
end select
case('PRMC_NEED_SYMMETRIZE')
select case(psb_toupper(trim(val)))
case('FALSE','F')
ag%need_symmetrize = .false.
case('SYMMETRIZE','TRUE','T')
ag%need_symmetrize =.true.
end select
case('PRMC_UNSMOOTHED_HIERARCHY')
select case(psb_toupper(trim(val)))
case('F','FALSE')
ag%unsmoothed_hierarchy = .false.
case('T','TRUE')
ag%unsmoothed_hierarchy =.true.
end select
case default
! Do nothing
end select
return
end subroutine amg_d_parmatch_aggr_csetc
subroutine amg_d_parmatch_aggr_cseti(ag,what,val,info,idx)
Implicit None
! Arguments
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, iwhat
character(len=20) :: name='d_parmatch_aggr_cseti'
info = psb_success_
! For now we ignore IDX
select case(psb_toupper(trim(what)))
case('PRMC_MATCH_ALG')
ag%matching_alg=val
case('PRMC_SWEEPS')
ag%n_sweeps=val
case('AGGR_SIZE')
ag%orig_aggr_size = val
ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
case('PRMC_W_SIZE')
call ag%bld_default_w(val)
case('PRMC_REPRODUCIBLE_MATCHING')
ag%reproducible_matching = (val == 1)
case('PRMC_NEED_SYMMETRIZE')
ag%need_symmetrize = (val == 1)
case('PRMC_UNSMOOTHED_HIERARCHY')
ag%unsmoothed_hierarchy = (val == 1)
case default
! Do nothing
end select
return
end subroutine amg_d_parmatch_aggr_cseti
subroutine amg_d_parmatch_aggr_set_default(ag)
Implicit None
! Arguments
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
character(len=20) :: name='d_parmatch_aggr_set_default'
call ag%amg_d_base_aggregator_type%default()
ag%matching_alg = 0
ag%n_sweeps = 1
ag%jacobi_sweeps = 0
!!$ ag%max_nlevels = 36
!!$ ag%max_csize = -1
!
! Apparently BootCMatch works better
! by keeping all entries
!
ag%do_clean_zeros = .false.
return
end subroutine amg_d_parmatch_aggr_set_default
subroutine amg_d_parmatch_aggregator_free(ag,info)
use iso_c_binding
implicit none
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
integer(psb_ipk_), intent(out) :: info
info = 0
if ((info == 0).and.allocated(ag%w)) deallocate(ag%w,stat=info)
if ((info == 0).and.allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info)
if ((info == 0).and.allocated(ag%prol)) then
call ag%prol%free(); deallocate(ag%prol,stat=info)
end if
if ((info == 0).and.allocated(ag%restr)) then
call ag%restr%free(); deallocate(ag%restr,stat=info)
end if
if ((info == 0).and.allocated(ag%ac)) then
call ag%ac%free(); deallocate(ag%ac,stat=info)
end if
if ((info == 0).and.allocated(ag%base_a)) then
call ag%base_a%free(); deallocate(ag%base_a,stat=info)
end if
if ((info == 0).and.allocated(ag%rwa)) then
call ag%rwa%free(); deallocate(ag%rwa,stat=info)
end if
if ((info == 0).and.allocated(ag%desc_ac)) then
call ag%desc_ac%free(info); deallocate(ag%desc_ac,stat=info)
end if
if ((info == 0).and.allocated(ag%desc_ax)) then
call ag%desc_ax%free(info); deallocate(ag%desc_ax,stat=info)
end if
if ((info == 0).and.allocated(ag%base_desc)) then
call ag%base_desc%free(info); deallocate(ag%base_desc,stat=info)
end if
if ((info == 0).and.allocated(ag%rwdesc)) then
call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
end if
end subroutine amg_d_parmatch_aggregator_free
subroutine amg_d_parmatch_aggregator_clone(ag,agnext,info)
implicit none
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
class(amg_d_base_aggregator_type), allocatable, intent(inout) :: agnext
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(agnext)) then
call agnext%free(info)
if (info == 0) deallocate(agnext,stat=info)
end if
if (info /= 0) return
allocate(agnext,source=ag,stat=info)
select type(agnext)
class is (amg_d_parmatch_aggregator_type)
call agnext%set_c_default_w()
class default
! Should never ever get here
info = -1
end select
end subroutine amg_d_parmatch_aggregator_clone
subroutine amg_d_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
& op_restr,op_prol,map,info)
use psb_base_mod
implicit none
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
type(psb_desc_type), intent(in), target :: desc_a, desc_ac
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_dspmat_type), intent(inout) :: op_prol, op_restr
type(psb_dlinmap_type), intent(out) :: map
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_parmatch_aggregator_bld_map'
call psb_erractionsave(err_act)
!
! Copy the prolongation/restriction matrices into the descriptor map.
! op_restr => PR^T i.e. restriction operator
! op_prol => PR i.e. prolongation operator
!
! For parmatch have an explicit copy of the descriptors
!
if (allocated(ag%desc_ax)) then
!!$ write(0,*) 'Building linmap with ag%desc_ax ',ag%desc_ax%get_local_rows(),ag%desc_ax%get_local_cols(),&
!!$ & desc_ac%get_local_rows(),desc_ac%get_local_cols()
map = psb_linmap(psb_map_gen_linear_,ag%desc_ax,&
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
else
map = psb_linmap(psb_map_gen_linear_,desc_a,&
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
end if
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_d_parmatch_aggregator_bld_map
#endif
end module amg_d_parmatch_aggregator_mod
+66 -4
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -40,7 +40,7 @@
! Module: amg_d_prec_mod
!
! This module defines the user interfaces to the real/complex, single/double
! precision versions of the user-level AMG4PSBLAS routines.
! precision versions of the user-level MLD2P4 routines.
!
module amg_d_prec_mod
@@ -55,7 +55,12 @@ module amg_d_prec_mod
use amg_d_ainv_solver
use amg_d_invk_solver
use amg_d_invt_solver
use amg_d_krm_solver
interface amg_precset
module procedure amg_d_iprecsetsm, amg_d_iprecsetsv, &
& amg_d_cprecseti, amg_d_cprecsetc, amg_d_cprecsetr, &
& amg_d_iprecsetag
end interface amg_precset
interface amg_extprol_bld
subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
@@ -77,4 +82,61 @@ module amg_d_prec_mod
end subroutine amg_d_extprol_bld
end interface amg_extprol_bld
contains
subroutine amg_d_iprecsetsm(p,val,info,pos)
type(amg_dprec_type), intent(inout) :: p
class(amg_d_base_smoother_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(val,info,pos=pos)
end subroutine amg_d_iprecsetsm
subroutine amg_d_iprecsetsv(p,val,info,pos)
type(amg_dprec_type), intent(inout) :: p
class(amg_d_base_solver_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(val,info, pos=pos)
end subroutine amg_d_iprecsetsv
subroutine amg_d_iprecsetag(p,val,info,pos)
type(amg_dprec_type), intent(inout) :: p
class(amg_d_base_aggregator_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(val,info, pos=pos)
end subroutine amg_d_iprecsetag
subroutine amg_d_cprecseti(p,what,val,info,pos)
type(amg_dprec_type), intent(inout) :: p
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(what,val,info,pos=pos)
end subroutine amg_d_cprecseti
subroutine amg_d_cprecsetr(p,what,val,info,pos)
type(amg_dprec_type), intent(inout) :: p
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(what,val,info,pos=pos)
end subroutine amg_d_cprecsetr
subroutine amg_d_cprecsetc(p,what,val,info,pos)
type(amg_dprec_type), intent(inout) :: p
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(what,val,info,pos=pos)
end subroutine amg_d_cprecsetc
end module amg_d_prec_mod
+17 -35
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -66,7 +66,7 @@ module amg_d_prec_type
!
! This is the data type containing all the information about the multilevel
! preconditioner ('d', 's', 'c' and 'z', according to the real/complex,
! single/double precision version of AMG4PSBLAS).
! single/double precision version of MLD2P4).
! It consists of an array of 'one-level' intermediate data structures
! of type amg_donelev_type, each containing the information needed to apply
! the smoothing and the coarse-space correction at a generic level. RT is the
@@ -155,16 +155,13 @@ 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,iout,root)
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(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
@@ -427,22 +424,11 @@ contains
end if
end function amg_d_get_nzeros
function amg_dprec_sizeof(prec, global) result(val)
function amg_dprec_sizeof(prec) result(val)
implicit none
class(amg_dprec_type), intent(in) :: prec
logical, intent(in), optional :: global
integer(psb_epk_) :: val
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
type(psb_ctxt_type) :: ctxt
logical :: global_
if (present(global)) then
global_ = global
else
global_ = .false.
end if
val = 0
val = val + psb_sizeof_ip
if (allocated(prec%precv)) then
@@ -450,11 +436,6 @@ contains
val = val + prec%precv(i)%sizeof()
end do
end if
if (global_) then
ctxt = prec%ctxt
call psb_sum(ctxt,val)
end if
end function amg_dprec_sizeof
!
@@ -757,15 +738,16 @@ contains
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
integer(psb_ipk_) :: i, j, il1, iln, lev
type(psb_ctxt_type) :: ctxt
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np, iproc_
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_
info = 0
ctxt = prec%ctxt
call psb_info(ctxt,iam,np)
icontxt = prec%ctxt
call psb_info(icontxt,iam,np)
iln = size(prec%precv)
if (present(istart)) then
il1 = max(1,istart)
@@ -830,13 +812,13 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, ln, lev
type(psb_ctxt_type) :: ctxt
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np
info = psb_success_
select type(pout => precout)
class is (amg_dprec_type)
pout%ctxt = prec%ctxt
pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps
if (allocated(prec%precv)) then
@@ -852,8 +834,8 @@ contains
if (info == psb_success_) then
pout%precv(lev)%base_a => pout%precv(lev)%ac
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
end if
end do
end if
@@ -893,8 +875,8 @@ contains
do i=2, size(b%precv)
b%precv(i)%base_a => b%precv(i)%ac
b%precv(i)%base_desc => b%precv(i)%desc_ac
b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
end do
else
@@ -1,14 +1,11 @@
!
!
!
!
! 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
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
@@ -55,14 +52,14 @@
! 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
! 3. The name of the MLD2P4 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
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 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
@@ -73,16 +70,16 @@
!
!
!
! File: amg_d_krm_solver_mod.f90
! File: amg_d_rkr_solver_mod.f90
!
! Module: amg_d_krm_solver_mod
! Module: amg_d_rkr_solver_mod
!
module amg_d_krm_solver
module amg_d_rkr_solver
use amg_d_base_solver_mod
use amg_d_prec_type
type, extends(amg_d_base_solver_type) :: amg_d_krm_solver_type
type, extends(amg_d_base_solver_type) :: amg_d_rkr_solver_type
!
logical :: global
character(len=16) :: method, kprec, sub_solve
@@ -97,46 +94,46 @@ module amg_d_krm_solver
contains
!
!
procedure, pass(sv) :: dump => d_krm_solver_dmp
procedure, pass(sv) :: check => d_krm_solver_check
procedure, pass(sv) :: clone => d_krm_solver_clone
procedure, pass(sv) :: clone_settings => d_krm_solver_clone_settings
procedure, pass(sv) :: cnv => d_krm_solver_cnv
procedure, pass(sv) :: apply_v => amg_d_krm_solver_apply_vect
procedure, pass(sv) :: apply_a => amg_d_krm_solver_apply
procedure, pass(sv) :: clear_data => d_krm_solver_clear_data
procedure, pass(sv) :: free => d_krm_solver_free
procedure, pass(sv) :: cseti => d_krm_solver_cseti
procedure, pass(sv) :: csetc => d_krm_solver_csetc
procedure, pass(sv) :: csetr => d_krm_solver_csetr
procedure, pass(sv) :: sizeof => d_krm_solver_sizeof
procedure, pass(sv) :: get_nzeros => d_krm_solver_get_nzeros
!procedure, nopass :: get_id => d_krm_solver_get_id
procedure, pass(sv) :: is_global => d_krm_solver_is_global
procedure, nopass :: is_iterative => d_krm_solver_is_iterative
procedure, pass(sv) :: dump => d_rkr_solver_dmp
procedure, pass(sv) :: check => d_rkr_solver_check
procedure, pass(sv) :: clone => d_rkr_solver_clone
procedure, pass(sv) :: clone_settings => d_rkr_solver_clone_settings
procedure, pass(sv) :: cnv => d_rkr_solver_cnv
procedure, pass(sv) :: apply_v => amg_d_rkr_solver_apply_vect
procedure, pass(sv) :: apply_a => amg_d_rkr_solver_apply
procedure, pass(sv) :: clear_data => d_rkr_solver_clear_data
procedure, pass(sv) :: free => d_rkr_solver_free
procedure, pass(sv) :: cseti => d_rkr_solver_cseti
procedure, pass(sv) :: csetc => d_rkr_solver_csetc
procedure, pass(sv) :: csetr => d_rkr_solver_csetr
procedure, pass(sv) :: sizeof => d_rkr_solver_sizeof
procedure, pass(sv) :: get_nzeros => d_rkr_solver_get_nzeros
!procedure, nopass :: get_id => d_rkr_solver_get_id
procedure, pass(sv) :: is_global => d_rkr_solver_is_global
procedure, nopass :: is_iterative => d_rkr_solver_is_iterative
!
! These methods are specific for the new solver type
! and therefore need to be overridden
!
procedure, pass(sv) :: descr => d_krm_solver_descr
procedure, pass(sv) :: default => d_krm_solver_default
procedure, pass(sv) :: build => amg_d_krm_solver_bld
procedure, nopass :: get_fmt => d_krm_solver_get_fmt
end type amg_d_krm_solver_type
procedure, pass(sv) :: descr => d_rkr_solver_descr
procedure, pass(sv) :: default => d_rkr_solver_default
procedure, pass(sv) :: build => amg_d_rkr_solver_bld
procedure, nopass :: get_fmt => d_rkr_solver_get_fmt
end type amg_d_rkr_solver_type
private :: d_krm_solver_get_fmt, d_krm_solver_descr, d_krm_solver_default
private :: d_rkr_solver_get_fmt, d_rkr_solver_descr, d_rkr_solver_default
interface
subroutine amg_d_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
subroutine amg_d_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,wv,info,init,initu)
import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
import :: psb_desc_type, amg_d_rkr_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_krm_solver_type), intent(inout) :: sv
class(amg_d_rkr_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
@@ -146,17 +143,17 @@ module amg_d_krm_solver
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu
end subroutine amg_d_krm_solver_apply_vect
end subroutine amg_d_rkr_solver_apply_vect
end interface
interface
subroutine amg_d_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
subroutine amg_d_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
import :: psb_desc_type, amg_d_rkr_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_krm_solver_type), intent(inout) :: sv
class(amg_d_rkr_solver_type), intent(inout) :: sv
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
@@ -165,24 +162,24 @@ module amg_d_krm_solver
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
real(psb_dpk_),intent(inout), optional :: initu(:)
end subroutine amg_d_krm_solver_apply
end subroutine amg_d_rkr_solver_apply
end interface
interface
subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
subroutine amg_d_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_d_rkr_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_krm_solver_type), intent(inout) :: sv
class(amg_d_rkr_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_krm_solver_bld
end subroutine amg_d_rkr_solver_bld
end interface
@@ -190,12 +187,12 @@ contains
!
!
subroutine d_krm_solver_default(sv)
subroutine d_rkr_solver_default(sv)
Implicit None
! Arguments
class(amg_d_krm_solver_type), intent(inout) :: sv
class(amg_d_rkr_solver_type), intent(inout) :: sv
sv%method = 'bicgstab'
sv%kprec = 'bjac'
@@ -210,42 +207,42 @@ contains
sv%global = .false.
return
end subroutine d_krm_solver_default
end subroutine d_rkr_solver_default
function d_krm_solver_get_nzeros(sv) result(val)
function d_rkr_solver_get_nzeros(sv) result(val)
implicit none
! Arguments
class(amg_d_krm_solver_type), intent(in) :: sv
class(amg_d_rkr_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
val = sv%prec%get_nzeros()
return
end function d_krm_solver_get_nzeros
end function d_rkr_solver_get_nzeros
function d_krm_solver_sizeof(sv) result(val)
function d_rkr_solver_sizeof(sv) result(val)
implicit none
! Arguments
class(amg_d_krm_solver_type), intent(in) :: sv
class(amg_d_rkr_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
return
end function d_krm_solver_sizeof
end function d_rkr_solver_sizeof
subroutine d_krm_solver_check(sv,info)
subroutine d_rkr_solver_check(sv,info)
Implicit None
! Arguments
class(amg_d_krm_solver_type), intent(inout) :: sv
class(amg_d_rkr_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_krm_solver_check'
character(len=20) :: name='d_rkr_solver_check'
call psb_erractionsave(err_act)
info = psb_success_
@@ -259,36 +256,36 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine d_krm_solver_check
end subroutine d_rkr_solver_check
subroutine d_krm_solver_cseti(sv,what,val,info,idx)
subroutine d_rkr_solver_cseti(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_d_krm_solver_type), intent(inout) :: sv
class(amg_d_rkr_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_krm_solver_cseti'
character(len=20) :: name='d_rkr_solver_cseti'
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(trim(what)))
case('KRM_IRST')
case('RKR_IRST')
sv%irst = val
case('KRM_ISTOPC')
case('RKR_ISTOPC')
sv%istopc = val
case('KRM_ITMAX')
case('RKR_ITMAX')
sv%itmax = val
case('KRM_ITRACE')
case('RKR_ITRACE')
sv%itrace = val
case('KRM_SUB_SOLVE')
case('RKR_SUB_SOLVE')
sv%i_sub_solve = val
case('KRM_FILLIN')
case('RKR_FILLIN')
sv%fillin = val
case default
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
@@ -299,33 +296,33 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine d_krm_solver_cseti
end subroutine d_rkr_solver_cseti
subroutine d_krm_solver_csetc(sv,what,val,info,idx)
subroutine d_rkr_solver_csetc(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_d_krm_solver_type), intent(inout) :: sv
class(amg_d_rkr_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_krm_solver_csetc'
character(len=20) :: name='d_rkr_solver_csetc'
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(trim(what)))
case('KRM_METHOD')
case('RKR_METHOD')
sv%method = psb_toupper(trim(val))
case('KRM_KPREC')
case('RKR_KPREC')
sv%kprec = psb_toupper(trim(val))
case('KRM_SUB_SOLVE')
case('RKR_SUB_SOLVE')
sv%sub_solve = psb_toupper(trim(val))
case('KRM_GLOBAL')
case('RKR_GLOBAL')
select case(psb_toupper(trim(val)))
case('LOCAL','FALSE')
sv%global = .false.
@@ -348,26 +345,26 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine d_krm_solver_csetc
end subroutine d_rkr_solver_csetc
subroutine d_krm_solver_csetr(sv,what,val,info,idx)
subroutine d_rkr_solver_csetr(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_d_krm_solver_type), intent(inout) :: sv
class(amg_d_rkr_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_krm_solver_csetr'
character(len=20) :: name='d_rkr_solver_csetr'
call psb_erractionsave(err_act)
info = psb_success_
select case(psb_toupper(what))
case('KRM_EPS')
case('RKR_EPS')
sv%eps = val
case default
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
@@ -378,18 +375,18 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine d_krm_solver_csetr
end subroutine d_rkr_solver_csetr
subroutine d_krm_solver_clear_data(sv,info)
subroutine d_rkr_solver_clear_data(sv,info)
use psb_base_mod, only : psb_exit
Implicit None
! Arguments
class(amg_d_krm_solver_type), intent(inout) :: sv
class(amg_d_rkr_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: l_ctxt
character(len=20) :: name='d_krm_solver_free'
character(len=20) :: name='d_rkr_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
@@ -406,19 +403,19 @@ contains
nullify(sv%a)
call psb_erractionrestore(err_act)
return
end subroutine d_krm_solver_clear_data
end subroutine d_rkr_solver_clear_data
subroutine d_krm_solver_free(sv,info)
subroutine d_rkr_solver_free(sv,info)
use psb_base_mod, only : psb_exit
Implicit None
! Arguments
class(amg_d_krm_solver_type), intent(inout) :: sv
class(amg_d_rkr_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: l_ctxt
character(len=20) :: name='d_krm_solver_free'
character(len=20) :: name='d_rkr_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
@@ -427,31 +424,29 @@ contains
call psb_erractionrestore(err_act)
return
end subroutine d_krm_solver_free
end subroutine d_rkr_solver_free
function d_krm_solver_get_fmt() result(val)
function d_rkr_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "KRM solver"
end function d_krm_solver_get_fmt
val = "RKR solver"
end function d_rkr_solver_get_fmt
subroutine d_krm_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_rkr_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_d_krm_solver_type), intent(in) :: sv
class(amg_d_rkr_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'
character(len=20), parameter :: name='amg_d_rkr_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -460,33 +455,34 @@ 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_,*) ' Recursive Krylov solver (global)'
else
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
write(iout_,*) ' Recursive Krylov solver (local) '
end if
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(iout_,info,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
9999 call psb_error_handler(err_act)
return
end subroutine d_krm_solver_descr
end subroutine d_rkr_solver_descr
subroutine d_krm_solver_cnv(sv,info,amold,vmold,imold)
subroutine d_rkr_solver_cnv(sv,info,amold,vmold,imold)
implicit none
class(amg_d_krm_solver_type), intent(inout) :: sv
class(amg_d_rkr_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
@@ -494,13 +490,13 @@ contains
call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
end subroutine d_krm_solver_cnv
end subroutine d_rkr_solver_cnv
subroutine d_krm_solver_clone(sv,svout,info)
subroutine d_rkr_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(amg_d_krm_solver_type), intent(inout) :: sv
class(amg_d_rkr_solver_type), intent(inout) :: sv
class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
@@ -509,7 +505,7 @@ contains
call svout%free(info)
allocate(svout,stat=info,mold=sv)
select type(so=>svout)
class is(amg_d_krm_solver_type)
class is(amg_d_rkr_solver_type)
so%method = sv%method
so%kprec = sv%kprec
so%sub_solve = sv%sub_solve
@@ -528,21 +524,21 @@ contains
info = psb_err_internal_error_
end select
end subroutine d_krm_solver_clone
end subroutine d_rkr_solver_clone
subroutine d_krm_solver_clone_settings(sv,svout,info)
subroutine d_rkr_solver_clone_settings(sv,svout,info)
Implicit None
! Arguments
class(amg_d_krm_solver_type), intent(inout) :: sv
class(amg_d_rkr_solver_type), intent(inout) :: sv
class(amg_d_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
info = psb_success_
select type(so=>svout)
class is(amg_d_krm_solver_type)
class is(amg_d_rkr_solver_type)
so%method = sv%method
so%kprec = sv%kprec
so%sub_solve = sv%sub_solve
@@ -558,11 +554,11 @@ contains
info = psb_err_internal_error_
end select
end subroutine d_krm_solver_clone_settings
end subroutine d_rkr_solver_clone_settings
subroutine d_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
subroutine d_rkr_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
implicit none
class(amg_d_krm_solver_type), intent(in) :: sv
class(amg_d_rkr_solver_type), intent(in) :: sv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
@@ -572,23 +568,23 @@ contains
call sv%prec%dump(info,prefix=prefix,head=head)
end subroutine d_krm_solver_dmp
end subroutine d_rkr_solver_dmp
!
! Notify whether KRM is used as a global solver
! Notify whether RKR is used as a global solver
!
function d_krm_solver_is_global(sv) result(val)
function d_rkr_solver_is_global(sv) result(val)
implicit none
class(amg_d_krm_solver_type), intent(in) :: sv
class(amg_d_rkr_solver_type), intent(in) :: sv
logical :: val
val = (sv%global)
end function d_krm_solver_is_global
end function d_rkr_solver_is_global
!
function d_krm_solver_is_iterative() result(val)
function d_rkr_solver_is_iterative() result(val)
implicit none
logical :: val
val = .true.
end function d_krm_solver_is_iterative
end function d_rkr_solver_is_iterative
end module amg_d_krm_solver
end module amg_d_rkr_solver
+7 -14
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+18 -43
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -52,7 +52,7 @@ module amg_d_sludist_solver
use iso_c_binding
use amg_d_base_solver_mod
#if (!defined(HAVE_SLUDIST_)) || defined(IPK8)
#if defined(LPK8)
type, extends(amg_d_base_solver_type) :: amg_d_sludist_solver_type
@@ -270,12 +270,10 @@ contains
! Local variables
type(psb_dspmat_type) :: atmp
type(psb_d_csr_sparse_mat) :: acsr
integer :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
integer :: ifrst, ibcheck
type(psb_ctxt_type) :: ctxt
integer(psb_lpk_), allocatable :: gia(:), gja(:)
integer(psb_lpk_) :: lfrst
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
integer(psb_ipk_) :: ifrst, ibcheck
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
integer :: np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_sludist_solver_bld', ch_err
info=psb_success_
@@ -295,36 +293,19 @@ contains
n_col = desc_a%get_local_cols()
nglob = desc_a%get_global_rows()
!
! Strategy here is as follows: because a call to SLUDIST
! as a gobal solver is mostly done at the coarsest level,
! even if we start from a problem requiring 8 bytes, chances
! are that the global size will be suitable for 4 bytes
! anyway, so we hope for the best, and throw an error
! if something goes wrong.
!
if (nglob > huge(1_psb_ipk_)) then
write(0,*) me,' ',trim(name),': Error: overflow of local indices '
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
call a%cscnv(atmp,info,type='csr')
! This in case we are dealing with AS
call a%cscnv(atmp,info,type='coo')
call psb_rwextd(n_row,atmp,info,b=b)
call atmp%cscnv(info,type='csr',dupl=psb_dupl_add_)
call atmp%mv_to(acsr)
nrow_a = acsr%get_nrows()
nztota = acsr%get_nzeros()
call psb_loc_to_glob(ione,lfrst,desc_a,info)
! Fix the entries to call C-base SuperLU
call psb_realloc(nztota,gja,info)
call psb_loc_to_glob(acsr%ja(1:nztota),gja(1:nztota), desc_a, info, iact='I')
acsr%ja(1:nztota) = gja(1:nztota)
call psb_loc_to_glob(1,ifrst,desc_a,info)
call psb_loc_to_glob(nrow_a,ibcheck,desc_a,info)
call psb_loc_to_glob(acsr%ja(1:nztota),desc_a,info,iact='I')
acsr%ja(:) = acsr%ja(:) - 1
acsr%irp(:) = acsr%irp(:) - 1
ifrst = lfrst - 1
ifrst = ifrst - 1
info = amg_dsludist_fact(nglob,nrow_a,nztota,ifrst,&
& acsr%val,acsr%irp,acsr%ja,sv%lufactors,&
& npr,npc)
@@ -337,6 +318,7 @@ contains
end if
call acsr%free()
call atmp%free()
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' end'
@@ -421,16 +403,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 +419,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 +427,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
+6 -15
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+7 -14
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+2 -2
View File
@@ -2,7 +2,7 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
@@ -40,7 +40,7 @@
! Module: amg_prec_mod
!
! This module defines the interfaces to the real/complex, single/double
! precision versions of the user-level AMG4PSBLAS routines.
! precision versions of the user-level MLD2P4 routines.
!
module amg_prec_mod
+1 -1
View File
@@ -2,7 +2,7 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
+48 -50
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
@@ -61,9 +58,10 @@ module amg_s_ainv_solver
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
!!$ procedure, pass(sv) :: seti => amg_s_ainv_solver_seti
!!$ procedure, pass(sv) :: setc => amg_s_ainv_solver_setc
!!$ procedure, pass(sv) :: setr => amg_s_ainv_solver_setr
procedure, pass(sv) :: seti => amg_s_ainv_solver_seti
procedure, pass(sv) :: setc => amg_s_ainv_solver_setc
procedure, pass(sv) :: setr => amg_s_ainv_solver_setr
generic, public :: set => seti, setr, setc
procedure, pass(sv) :: descr => amg_s_ainv_solver_descr
procedure, pass(sv) :: default => s_ainv_solver_default
procedure, nopass :: stringval => s_ainv_stringval
@@ -161,44 +159,44 @@ module amg_s_ainv_solver
end subroutine amg_s_ainv_solver_csetr
end interface
!!$ interface
!!$ subroutine amg_s_ainv_solver_setc(sv,what,val,info)
!!$ import :: amg_s_ainv_solver_type, psb_ipk_
!!$ Implicit none
!!$ ! Arguments
!!$ class(amg_s_ainv_solver_type), intent(inout) :: sv
!!$ integer(psb_ipk_), intent(in) :: what
!!$ character(len=*), intent(in) :: val
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_s_ainv_solver_setc
!!$ end interface
!!$
!!$ interface
!!$ subroutine amg_s_ainv_solver_seti(sv,what,val,info)
!!$ import :: amg_s_ainv_solver_type, psb_ipk_
!!$ Implicit none
!!$ ! Arguments
!!$ class(amg_s_ainv_solver_type), intent(inout) :: sv
!!$ integer(psb_ipk_), intent(in) :: what
!!$ integer(psb_ipk_), intent(in) :: val
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_s_ainv_solver_seti
!!$ end interface
!!$
!!$ interface
!!$ subroutine amg_s_ainv_solver_setr(sv,what,val,info)
!!$ import :: amg_s_ainv_solver_type, psb_ipk_, psb_spk_
!!$ Implicit none
!!$ ! Arguments
!!$ class(amg_s_ainv_solver_type), intent(inout) :: sv
!!$ integer(psb_ipk_), intent(in) :: what
!!$ real(psb_spk_), intent(in) :: val
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_s_ainv_solver_setr
!!$ end interface
interface
subroutine amg_s_ainv_solver_setc(sv,what,val,info)
import :: amg_s_ainv_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_s_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_ainv_solver_setc
end interface
interface
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_s_ainv_solver_seti(sv,what,val,info)
import :: amg_s_ainv_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_s_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_ainv_solver_seti
end interface
interface
subroutine amg_s_ainv_solver_setr(sv,what,val,info)
import :: amg_s_ainv_solver_type, psb_ipk_, psb_spk_
Implicit none
! Arguments
class(amg_s_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_ainv_solver_setr
end interface
interface
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
Implicit None
@@ -208,7 +206,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
+11 -18
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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)
+7 -14
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -126,7 +126,7 @@ module amg_s_base_aggregator_mod
& psb_s_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
implicit none
type(psb_s_csr_sparse_mat), intent(inout) :: a_csr
type(psb_desc_type), intent(inout) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: nlaggr(:)
type(amg_sml_parms), intent(inout) :: parms
type(psb_s_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -144,7 +144,7 @@ module amg_s_base_aggregator_mod
& psb_s_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
implicit none
type(psb_s_csr_sparse_mat), intent(inout) :: a_csr
type(psb_desc_type), intent(inout) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: nlaggr(:)
type(amg_sml_parms), intent(inout) :: parms
type(psb_s_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -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
+7 -10
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
+3 -4
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+4 -4
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+6 -13
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+8 -22
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+14 -28
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+1 -1
View File
@@ -2,7 +2,7 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
+5 -12
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+2 -2
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
+9 -16
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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)
+3 -3
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -39,7 +39,7 @@
!
! Module: amg_inner_mod
!
! This module defines the interfaces to inner AMG4PSBLAS routines.
! This module defines the interfaces to inner MLD2P4 routines.
! The interfaces of the user level routines are defined in amg_prec_mod.f90.
!
module amg_s_inner_mod
+23 -12
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
@@ -54,6 +51,8 @@ module amg_s_invk_solver
procedure, pass(sv) :: clone => amg_s_invk_solver_clone
procedure, pass(sv) :: build => amg_s_invk_solver_bld
procedure, pass(sv) :: cseti => amg_s_invk_solver_cseti
procedure, pass(sv) :: seti => amg_s_invk_solver_seti
generic, public :: set => seti
procedure, pass(sv) :: descr => amg_s_invk_solver_descr
procedure, pass(sv) :: default => s_invk_solver_default
end type amg_s_invk_solver_type
@@ -123,7 +122,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
@@ -133,10 +132,22 @@ 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
interface
subroutine amg_s_invk_solver_seti(sv,what,val,info)
import :: amg_s_invk_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_s_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_invk_solver_seti
end interface
contains
subroutine s_invk_solver_default(sv)
+38 -15
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
@@ -55,6 +52,9 @@ module amg_s_invt_solver
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
procedure, pass(sv) :: seti => amg_s_invt_solver_seti
procedure, pass(sv) :: setr => amg_s_invt_solver_setr
generic, public :: set => seti, setr
procedure, pass(sv) :: descr => amg_s_invt_solver_descr
procedure, pass(sv) :: default => s_invt_solver_default
end type amg_s_invt_solver_type
@@ -134,21 +134,44 @@ 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
interface
subroutine amg_s_invt_solver_setr(sv,what,val,info)
import :: amg_s_invt_solver_type, psb_spk_, psb_ipk_
Implicit none
! Arguments
class(amg_s_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_invt_solver_setr
end interface
interface
subroutine amg_s_invt_solver_seti(sv,what,val,info)
import :: amg_s_invt_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_s_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine
end interface
contains
subroutine s_invt_solver_default(sv)
+8 -10
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
File diff suppressed because it is too large Load Diff
+8 -15
View File
@@ -3,9 +3,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -313,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_
@@ -339,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
+164 -305
View File
@@ -1,15 +1,15 @@
!
!
!
!
! 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
!
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
! 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:
@@ -21,7 +21,7 @@
! 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
@@ -33,22 +33,22 @@
! 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_onelev_mod.f90
!
! Module: amg_s_onelev_mod
!
! This module defines:
! This module defines:
! - the amg_s_onelev_type data structure containing one level
! of a multilevel preconditioner and related
! data structures;
!
! It contains routines for
! - Building and applying;
! - Building and applying;
! - checking if the preconditioner is correctly defined;
! - printing a description of the preconditioner;
! - deallocating the preconditioner data structure.
! - deallocating the preconditioner data structure.
!
module amg_s_onelev_mod
@@ -56,8 +56,6 @@ module amg_s_onelev_mod
use amg_base_prec_type
use amg_s_base_smoother_mod
use amg_s_dec_aggregator_mod
use amg_s_parmatch_aggregator_mod
use psb_base_mod, only : psb_sspmat_type, psb_s_vect_type, &
& psb_s_base_vect_type, psb_lsspmat_type, psb_slinmap_type, psb_spk_, &
& psb_ipk_, psb_epk_, psb_lpk_, psb_desc_type, psb_i_base_vect_type, &
@@ -75,16 +73,16 @@ module amg_s_onelev_mod
! class(amg_s_base_smoother_type), pointer :: sm2 => null()
! class(amg_smlprec_wrk_type), allocatable :: wrk
! class(amg_s_base_aggregator_type), allocatable :: aggr
! type(amg_sml_parms) :: parms
! type(amg_sml_parms) :: parms
! type(psb_sspmat_type) :: ac
! type(psb_sesc_type) :: desc_ac
! type(psb_sspmat_type), pointer :: base_a => null()
! type(psb_desc_type), pointer :: base_desc => null()
! type(psb_sspmat_type), pointer :: base_a => null()
! type(psb_desc_type), pointer :: base_desc => null()
! type(psb_slinmap_type) :: map
! end type amg_sonelev_type
!
! Note that s denotes the kind of the real data type to be chosen
! according to single/double precision version of AMG4PSBLAS.
! according to single/double precision version of MLD2P4.
!
! sm,sm2a - class(amg_s_base_smoother_type), allocatable
! The current level pre- and post-smooother.
@@ -95,7 +93,7 @@ module amg_s_onelev_mod
! Workspace for application of preconditioner; may be
! pre-allocated to save time in the application within a
! Krylov solver.
! aggr - class(amg_s_base_aggregator_type), allocatable
! aggr - class(amg_s_base_aggregator_type), allocatable
! The aggregator object: holds the algorithmic choices and
! (possibly) additional data for building the aggregation.
! parms - type(amg_sml_parms)
@@ -106,7 +104,7 @@ module amg_s_onelev_mod
! The communication descriptor associated to the matrix
! stored in ac.
! base_a - type(psb_sspmat_type), pointer.
! Pointer (really a pointer!) to the local part of the current
! Pointer (really a pointer!) to the local part of the current
! matrix (so we have a unified treatment of residuals).
! We need this to avoid passing explicitly the current matrix
! to the routine which applies the preconditioner.
@@ -117,13 +115,13 @@ module amg_s_onelev_mod
! vector spaces associated to the index spaces of the previous
! and current levels.
!
! Methods:
! Methods:
! Most methods follow the encapsulation hierarchy: they take whatever action
! is appropriate for the current object, then call the corresponding method for
! the contained object.
! As an example: the descr() method prints out a description of the
! level. It starts by invoking the descr() method of the parms object,
! then calls the descr() method of the smoother object.
! then calls the descr() method of the smoother object.
!
! descr - Prints a description of the object.
! default - Set default values
@@ -132,14 +130,14 @@ module amg_s_onelev_mod
! it is passed to the smoother object for further processing.
! check - Sanity checks.
! sizeof - Total memory occupation in bytes
! get_nzeros - Number of nonzeros
! get_nzeros - Number of nonzeros
! get_wrksz - How many workspace vector does apply_vect need
! allocate_wrk - Allocate auxiliary workspace
! free_wrk - Free auxiliary workspace
! bld_tprol - Invoke the aggr method to build the tentative prolongator
! mat_asb - Build the final (possibly smoothed) prolongator and coarse matrix.
!
! mat_asb - Build the final (possibly smoothed) prolongator and coarse matrix.
!
!
type amg_smlprec_wrk_type
real(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
type(psb_s_vect_type) :: vtx, vty, vx2l, vy2l
@@ -150,35 +148,25 @@ module amg_s_onelev_mod
procedure, pass(wk) :: clone => s_wrk_clone
procedure, pass(wk) :: move_alloc => s_wrk_move_alloc
procedure, pass(wk) :: cnv => s_wrk_cnv
procedure, pass(wk) :: sizeof => s_wrk_sizeof
procedure, pass(wk) :: sizeof => s_wrk_sizeof
end type amg_smlprec_wrk_type
private :: s_wrk_alloc, s_wrk_free, &
& s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv, s_wrk_sizeof
type amg_s_remap_data_type
type(psb_sspmat_type) :: ac_pre_remap
type(psb_desc_type) :: desc_ac_pre_remap
integer(psb_ipk_) :: idest
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
contains
procedure, pass(rmp) :: clone => s_remap_data_clone
end type amg_s_remap_data_type
& s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv, s_wrk_sizeof
type amg_s_onelev_type
class(amg_s_base_smoother_type), allocatable :: sm, sm2a
class(amg_s_base_smoother_type), pointer :: sm2 => null()
class(amg_smlprec_wrk_type), allocatable :: wrk
class(amg_s_base_aggregator_type), allocatable :: aggr
type(amg_sml_parms) :: parms
type(amg_sml_parms) :: parms
type(psb_sspmat_type) :: ac
integer(psb_ipk_) :: ac_nz_loc
integer(psb_lpk_) :: ac_nz_tot
type(psb_desc_type) :: desc_ac
type(psb_sspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_sspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_lsspmat_type) :: tprol
type(psb_slinmap_type) :: linmap
type(amg_s_remap_data_type) :: remap_data
type(psb_slinmap_type) :: map
real(psb_spk_) :: szratio
contains
procedure, pass(lv) :: bld_tprol => s_base_onelev_bld_tprol
@@ -199,7 +187,7 @@ module amg_s_onelev_mod
procedure, pass(lv) :: setsm => amg_s_base_onelev_setsm
procedure, pass(lv) :: setsv => amg_s_base_onelev_setsv
procedure, pass(lv) :: setag => amg_s_base_onelev_setag
generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag
generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag
procedure, pass(lv) :: sizeof => s_base_onelev_sizeof
procedure, pass(lv) :: get_nzeros => s_base_onelev_get_nzeros
procedure, pass(lv) :: get_wrksz => s_base_onelev_get_wrksize
@@ -207,14 +195,7 @@ module amg_s_onelev_mod
procedure, pass(lv) :: free_wrk => s_base_onelev_free_wrk
procedure, nopass :: stringval => amg_stringval
procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc
procedure, pass(lv) :: map_rstr_a => amg_s_base_onelev_map_rstr_a
procedure, pass(lv) :: map_prol_a => amg_s_base_onelev_map_prol_a
procedure, pass(lv) :: map_rstr_v => amg_s_base_onelev_map_rstr_v
procedure, pass(lv) :: map_prol_v => amg_s_base_onelev_map_prol_v
generic, public :: map_rstr => map_rstr_a, map_rstr_v
generic, public :: map_prol => map_prol_a, map_prol_v
end type amg_s_onelev_type
type amg_s_onelev_node
@@ -228,11 +209,11 @@ module amg_s_onelev_mod
& s_base_onelev_get_wrksize, s_base_onelev_allocate_wrk, &
& s_base_onelev_free_wrk
interface
interface
subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lsspmat_type, psb_lpk_
import :: amg_s_onelev_type
implicit none
implicit none
class(amg_s_onelev_type), intent(inout), target :: lv
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a
@@ -257,143 +238,141 @@ module amg_s_onelev_mod
end subroutine amg_s_base_onelev_build
end interface
interface
subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
interface
subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_s_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
class(amg_s_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
end subroutine amg_s_base_onelev_descr
end interface
interface
interface
subroutine amg_s_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_s_onelev_type, psb_s_base_vect_type, psb_spk_, &
& psb_s_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
! Arguments
class(amg_s_onelev_type), intent(inout) :: lv
class(amg_s_onelev_type), intent(inout) :: lv
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_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, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none
implicit none
class(amg_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_base_onelev_free
end interface
interface
interface
subroutine amg_s_base_onelev_check(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
! Arguments
class(amg_s_onelev_type), intent(inout) :: lv
class(amg_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_base_onelev_check
end interface
interface
interface
subroutine amg_s_base_onelev_setsm(lv,val,info,pos)
import :: psb_spk_, amg_s_onelev_type, amg_s_base_smoother_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_base_smoother_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine amg_s_base_onelev_setsm
end interface
interface
interface
subroutine amg_s_base_onelev_setsv(lv,val,info,pos)
import :: psb_spk_, amg_s_onelev_type, amg_s_base_solver_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_base_solver_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine amg_s_base_onelev_setsv
end interface
interface
interface
subroutine amg_s_base_onelev_setag(lv,val,info,pos)
import :: psb_spk_, amg_s_onelev_type, amg_s_base_aggregator_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_base_aggregator_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
end subroutine amg_s_base_onelev_setag
end interface
interface
interface
subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
end subroutine amg_s_base_onelev_cseti
end interface
interface
interface
subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
end subroutine amg_s_base_onelev_csetc
end interface
interface
interface
subroutine amg_s_base_onelev_csetr(lv,what,val,info,pos,idx)
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
character(len=*), intent(in) :: what
class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
@@ -401,13 +380,13 @@ interface
end subroutine amg_s_base_onelev_csetr
end interface
interface
interface
subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
& solver,tprol,global_num)
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
implicit none
class(amg_s_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
@@ -415,62 +394,15 @@ interface
logical, optional, intent(in) :: ac, rp, smoother, solver, tprol, global_num
end subroutine amg_s_base_onelev_dump
end interface
interface
subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
import
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta
real(psb_spk_), intent(inout) :: u(:)
real(psb_spk_), intent(out) :: v(:)
integer(psb_ipk_), intent(out) :: info
real(psb_spk_), optional :: work(:)
end subroutine amg_s_base_onelev_map_rstr_a
subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
import
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta
type(psb_s_vect_type), intent(inout) :: vect_u, vect_v
integer(psb_ipk_), intent(out) :: info
real(psb_spk_), optional :: work(:)
type(psb_s_vect_type), optional, target, intent(inout) :: vtx,vty
end subroutine amg_s_base_onelev_map_rstr_v
end interface
interface
subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
import
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta
real(psb_spk_), intent(inout) :: u(:)
real(psb_spk_), intent(out) :: v(:)
integer(psb_ipk_), intent(out) :: info
real(psb_spk_), optional :: work(:)
end subroutine amg_s_base_onelev_map_prol_a
subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
import
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta
type(psb_s_vect_type), intent(inout) :: vect_u, vect_v
integer(psb_ipk_), intent(out) :: info
real(psb_spk_), optional :: work(:)
type(psb_s_vect_type), optional, target, intent(inout) :: vtx,vty
end subroutine amg_s_base_onelev_map_prol_v
end interface
contains
!
! Function returning the size of the amg_prec_type data structure
! in bytes or in number of nonzeros of the operator(s) involved.
! in bytes or in number of nonzeros of the operator(s) involved.
!
function s_base_onelev_get_nzeros(lv) result(val)
implicit none
implicit none
class(amg_s_onelev_type), intent(in) :: lv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
@@ -482,16 +414,16 @@ contains
end function s_base_onelev_get_nzeros
function s_base_onelev_sizeof(lv) result(val)
implicit none
implicit none
class(amg_s_onelev_type), intent(in) :: lv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = psb_sizeof_ip+psb_sizeof_lp
val = val + lv%desc_ac%sizeof()
val = val + lv%ac%sizeof()
val = val + lv%tprol%sizeof()
val = val + lv%linmap%sizeof()
val = val + lv%map%sizeof()
if (allocated(lv%sm)) val = val + lv%sm%sizeof()
if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -500,19 +432,19 @@ contains
subroutine s_base_onelev_nullify(lv)
implicit none
implicit none
class(amg_s_onelev_type), intent(inout) :: lv
nullify(lv%base_a)
nullify(lv%base_desc)
nullify(lv%base_a)
nullify(lv%base_desc)
nullify(lv%sm2)
end subroutine s_base_onelev_nullify
!
! Multilevel defaults:
! Multilevel defaults:
! multiplicative vs. additive ML framework;
! Smoothed decoupled aggregation with zero threshold;
! Smoothed decoupled aggregation with zero threshold;
! distributed coarse matrix;
! damping omega computed with the max-norm estimate of the
! dominant eigenvalue;
@@ -522,10 +454,10 @@ contains
subroutine s_base_onelev_default(lv)
Implicit None
! Arguments
class(amg_s_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_) :: info
integer(psb_ipk_) :: info
lv%parms%sweeps_pre = 1
lv%parms%sweeps_post = 1
@@ -540,7 +472,7 @@ contains
lv%parms%aggr_filter = amg_no_filter_mat_
lv%parms%aggr_omega_val = szero
lv%parms%aggr_thresh = 0.01_psb_spk_
if (allocated(lv%sm)) call lv%sm%default()
if (allocated(lv%sm2a)) then
call lv%sm2a%default()
@@ -550,7 +482,7 @@ contains
end if
if (.not.allocated(lv%aggr)) allocate(amg_s_dec_aggregator_type :: lv%aggr,stat=info)
if (allocated(lv%aggr)) call lv%aggr%default()
return
end subroutine s_base_onelev_default
@@ -565,9 +497,9 @@ contains
type(psb_lsspmat_type), intent(out) :: t_prol
type(amg_saggr_data), intent(in) :: ag_data
integer(psb_ipk_), intent(out) :: info
call lv%aggr%bld_tprol(lv%parms,ag_data,a,desc_a,ilaggr,nlaggr,t_prol,info)
end subroutine s_base_onelev_bld_tprol
@@ -577,7 +509,7 @@ contains
integer(psb_ipk_), intent(out) :: info
call lv%aggr%update_next(lvnext%aggr,info)
end subroutine s_base_onelev_update_aggr
@@ -586,33 +518,33 @@ contains
Implicit None
! Arguments
class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_onelev_type), target, intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (allocated(lv%sm)) then
if (allocated(lv%sm)) then
call lv%sm%clone(lvout%sm,info)
else
if (allocated(lvout%sm)) then
else
if (allocated(lvout%sm)) then
call lvout%sm%free(info)
if (info==psb_success_) deallocate(lvout%sm,stat=info)
end if
end if
if (allocated(lv%sm2a)) then
if (allocated(lv%sm2a)) then
call lv%sm%clone(lvout%sm2a,info)
lvout%sm2 => lvout%sm2a
else
if (allocated(lvout%sm2a)) then
else
if (allocated(lvout%sm2a)) then
call lvout%sm2a%free(info)
if (info==psb_success_) deallocate(lvout%sm2a,stat=info)
end if
lvout%sm2 => lvout%sm
end if
if (allocated(lv%aggr)) then
if (allocated(lv%aggr)) then
call lv%aggr%clone(lvout%aggr,info)
else
if (allocated(lvout%aggr)) then
if (allocated(lvout%aggr)) then
call lvout%aggr%free(info)
if (info==psb_success_) deallocate(lvout%aggr,stat=info)
end if
@@ -621,11 +553,10 @@ contains
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
if (info == psb_success_) call lv%map%clone(lvout%map,info)
lvout%base_a => lv%base_a
lvout%base_desc => lv%base_desc
return
end subroutine s_base_onelev_clone
@@ -634,12 +565,12 @@ contains
use psb_base_mod
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call b%free(info)
b%parms = lv%parms
b%szratio = lv%szratio
if (associated(lv%sm2,lv%sm2a)) then
if (associated(lv%sm2,lv%sm2a)) then
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm2a
@@ -650,18 +581,18 @@ contains
end if
call move_alloc(lv%aggr,b%aggr)
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
b%base_a => lv%base_a
b%base_desc => lv%base_desc
end subroutine s_base_onelev_move_alloc
function s_base_onelev_get_wrksize(lv) result(val)
implicit none
implicit none
class(amg_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_) :: val
@@ -682,54 +613,44 @@ contains
select case(lv%parms%ml_cycle)
case(amg_add_ml_,amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
! We're good
case(amg_kcycle_ml_, amg_kcyclesym_ml_)
!
! We need 7 in inneritkcycle.
! Can we reuse vtx?
!
! Can we reuse vtx?
!
val = val + 7
case default
! Need a better error signaling ?
val = -1
end select
end function s_base_onelev_get_wrksize
subroutine s_base_onelev_allocate_wrk(lv,info,vmold)
use psb_base_mod
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: nwv, i
info = psb_success_
nwv = lv%get_wrksz()
if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
if (info == 0) then
if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
!
! Need to fix this, we need two different allocations
!
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
& desc2=lv%remap_data%desc_ac_pre_remap)
else
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
end if
end if
if (info == 0) call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
end subroutine s_base_onelev_allocate_wrk
subroutine s_base_onelev_free_wrk(lv,info)
use psb_base_mod
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: nwv,i
integer(psb_ipk_) :: nwv,i
info = psb_success_
if (allocated(lv%wrk)) then
@@ -737,88 +658,46 @@ contains
if (info == 0) deallocate(lv%wrk,stat=info)
end if
end subroutine s_base_onelev_free_wrk
subroutine s_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
subroutine s_wrk_alloc(wk,nwv,desc,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
!
integer(psb_ipk_) :: i
info = psb_success_
call wk%free(info)
if (present(desc2)) then
!!$ write(0,*) 'Check on wrk_alloc 2',&
!!$ & desc2%get_local_rows(), desc%get_local_rows(),&
!!$ & desc2%get_local_cols(),desc%get_local_cols()
!!$ flush(0)
if (desc2%get_local_cols()>desc%get_local_cols()) then
call psb_geasb(wk%vx2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc2,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc2,info,&
& scratch=.true.,mold=vmold)
end do
else
!!$ write(0,*) 'Check on wrk_alloc 1.5 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
else
!!$ write(0,*) 'Check on wrk_alloc 1 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
end do
end subroutine s_wrk_alloc
subroutine s_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
@@ -839,7 +718,7 @@ contains
end if
end subroutine s_wrk_free
subroutine s_wrk_clone(wk,wkout,info)
use psb_base_mod
Implicit None
@@ -847,11 +726,11 @@ contains
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
class(amg_smlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
@@ -873,12 +752,12 @@ contains
return
end subroutine s_wrk_clone
subroutine s_wrk_move_alloc(wk, b,info)
implicit none
class(amg_smlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
call b%free(info)
call move_alloc(wk%tx,b%tx)
call move_alloc(wk%ty,b%ty)
@@ -891,17 +770,17 @@ contains
call move_alloc(wk%vx2l%v,b%vx2l%v)
call move_alloc(wk%vy2l%v,b%vy2l%v)
call move_alloc(wk%wv,b%wv)
end subroutine s_wrk_move_alloc
subroutine s_wrk_cnv(wk,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: i
@@ -922,7 +801,7 @@ contains
function s_wrk_sizeof(wk) result(val)
use psb_realloc_mod
implicit none
implicit none
class(amg_smlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
integer :: i
@@ -941,25 +820,5 @@ contains
end do
end if
end function s_wrk_sizeof
subroutine s_remap_data_clone(rmp, remap_out, info)
use psb_base_mod
implicit none
! Arguments
class(amg_s_remap_data_type), target, intent(inout) :: rmp
class(amg_s_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
if (info == psb_success_) &
& call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
remap_out%idest = rmp%idest
call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
end subroutine s_remap_data_clone
end module amg_s_onelev_mod
-689
View File
@@ -1,689 +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.
!
! moved here from amg4psblas-extension
!
!
! AMG4PSBLAS Extensions
!
! (C) Copyright 2019
!
! Salvatore Filippone Cranfield University
! Pasqua D'Ambra IAC-CNR, Naples, IT
!
! 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.
!
!
!
!
! The aggregator object hosts the aggregation method for building
! the multilevel hierarchy. This variant is based on the hybrid method
! presented in
!
!
! sm - class(amg_T_base_smoother_type), allocatable
! The current level preconditioner (aka smoother).
! parms - type(amg_RTml_parms)
! The parameters defining the multilevel strategy.
! ac - The local part of the current-level matrix, built by
! coarsening the previous-level matrix.
! desc_ac - type(psb_desc_type).
! The communication descriptor associated to the matrix
! stored in ac.
! base_a - type(psb_Tspmat_type), pointer.
! Pointer (really a pointer!) to the local part of the current
! matrix (so we have a unified treatment of residuals).
! We need this to avoid passing explicitly the current matrix
! to the routine which applies the preconditioner.
! base_desc - type(psb_desc_type), pointer.
! Pointer to the communication descriptor associated to the
! matrix pointed by base_a.
! map - Stores the maps (restriction and prolongation) between the
! vector spaces associated to the index spaces of the previous
! and current levels.
!
! Methods:
! Most methods follow the encapsulation hierarchy: they take whatever action
! is appropriate for the current object, then call the corresponding method for
! the contained object.
! As an example: the descr() method prints out a description of the
! level. It starts by invoking the descr() method of the parms object,
! then calls the descr() method of the smoother object.
!
! descr - Prints a description of the object.
! default - Set default values
! dump - Dump to file object contents
! set - Sets various parameters; when a request is unknown
! it is passed to the smoother object for further processing.
! check - Sanity checks.
! sizeof - Total memory occupation in bytes
! get_nzeros - Number of nonzeros
!
!
module amg_s_parmatch_aggregator_mod
use amg_s_base_aggregator_mod
use amg_s_matchboxp_mod
#if defined(SERIAL_MPI)
type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
end type amg_s_parmatch_aggregator_type
#else
type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
integer(psb_ipk_) :: matching_alg
integer(psb_ipk_) :: n_sweeps ! When n_sweeps >1 we need an auxiliary descriptor
integer(psb_ipk_) :: orig_aggr_size
integer(psb_ipk_) :: jacobi_sweeps
real(psb_spk_), allocatable :: w(:), w_nxt(:)
type(psb_sspmat_type), allocatable :: prol, restr
type(psb_sspmat_type), allocatable :: ac, base_a, rwa
type(psb_desc_type), allocatable :: desc_ac, desc_ax, base_desc, rwdesc
logical :: reproducible_matching = .false.
logical :: need_symmetrize = .false.
logical :: unsmoothed_hierarchy = .true.
contains
procedure, pass(ag) :: bld_tprol => amg_s_parmatch_aggregator_build_tprol
procedure, pass(ag) :: mat_bld => amg_s_parmatch_aggregator_mat_bld
procedure, pass(ag) :: mat_asb => amg_s_parmatch_aggregator_mat_asb
procedure, pass(ag) :: inner_mat_asb => amg_s_parmatch_aggregator_inner_mat_asb
procedure, pass(ag) :: bld_map => amg_s_parmatch_aggregator_bld_map
procedure, pass(ag) :: csetc => amg_s_parmatch_aggr_csetc
procedure, pass(ag) :: cseti => amg_s_parmatch_aggr_cseti
procedure, pass(ag) :: default => amg_s_parmatch_aggr_set_default
procedure, pass(ag) :: sizeof => amg_s_parmatch_aggregator_sizeof
procedure, pass(ag) :: update_next => amg_s_parmatch_aggregator_update_next
procedure, pass(ag) :: bld_wnxt => amg_s_parmatch_bld_wnxt
procedure, pass(ag) :: bld_default_w => amg_s_bld_default_w
procedure, pass(ag) :: set_c_default_w => amg_s_set_prm_c_default_w
procedure, pass(ag) :: descr => amg_s_parmatch_aggregator_descr
procedure, pass(ag) :: clone => amg_s_parmatch_aggregator_clone
procedure, pass(ag) :: free => amg_s_parmatch_aggregator_free
procedure, nopass :: fmt => amg_s_parmatch_aggregator_fmt
procedure, nopass :: xt_desc => amg_s_parmatch_aggregator_xt_desc
end type amg_s_parmatch_aggregator_type
interface
subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,t_prol,info)
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
implicit none
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
type(amg_sml_parms), intent(inout) :: parms
type(amg_saggr_data), intent(in) :: ag_data
type(psb_sspmat_type), intent(inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
type(psb_lsspmat_type), intent(out) :: t_prol
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_parmatch_aggregator_build_tprol
end interface
interface
subroutine amg_s_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
implicit none
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
type(amg_sml_parms), intent(inout) :: parms
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lsspmat_type), intent(inout) :: t_prol
type(psb_sspmat_type), intent(out) :: op_prol,ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_parmatch_aggregator_mat_bld
end interface
interface
subroutine amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
& ac,desc_ac, op_prol,op_restr,info)
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
implicit none
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
type(amg_sml_parms), intent(inout) :: parms
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a
type(psb_sspmat_type), intent(inout) :: op_prol,ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_parmatch_aggregator_mat_asb
end interface
interface
subroutine amg_s_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
& ac,desc_ac, op_prol,op_restr,info)
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
implicit none
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
type(amg_sml_parms), intent(inout) :: parms
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_sspmat_type), intent(inout) :: op_prol,op_restr
type(psb_sspmat_type), intent(inout) :: ac
type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_parmatch_aggregator_inner_mat_asb
end interface
interface
subroutine amg_s_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
implicit none
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(amg_sml_parms), intent(inout) :: parms
type(psb_lsspmat_type), intent(inout) :: t_prol
type(psb_sspmat_type), intent(inout) :: ac, op_prol, op_restr
type(psb_desc_type), intent(out) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_parmatch_spmm_bld
end interface
interface
subroutine amg_s_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
implicit none
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(amg_sml_parms), intent(inout) :: parms
type(psb_lsspmat_type), intent(inout) :: t_prol
type(psb_sspmat_type), intent(inout) :: op_prol,ac, op_restr
type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_parmatch_unsmth_bld
end interface
interface
subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
implicit none
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(amg_sml_parms), intent(inout) :: parms
type(psb_lsspmat_type), intent(inout) :: t_prol
type(psb_sspmat_type), intent(inout) :: op_prol,ac, op_restr
type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_parmatch_smth_bld
end interface
interface
subroutine amg_s_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
implicit none
type(psb_sspmat_type), intent(inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(amg_sml_parms), intent(inout) :: parms
type(psb_lsspmat_type), intent(inout) :: t_prol
type(psb_sspmat_type), intent(inout) :: op_prol,ac, op_restr
type(psb_desc_type), intent(out) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_parmatch_spmm_bld_ov
end interface
interface
subroutine amg_s_parmatch_spmm_bld_inner(a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data,&
& psb_s_csr_sparse_mat, psb_ls_csr_sparse_mat
implicit none
type(psb_s_csr_sparse_mat), intent(inout) :: a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(amg_sml_parms), intent(inout) :: parms
type(psb_lsspmat_type), intent(inout) :: t_prol
type(psb_sspmat_type), intent(inout) :: op_prol,ac, op_restr
type(psb_desc_type), intent(out) :: desc_ac
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_parmatch_spmm_bld_inner
end interface
private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels
contains
subroutine amg_s_bld_default_w(ag,nr)
use psb_realloc_mod
implicit none
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
integer(psb_ipk_), intent(in) :: nr
integer(psb_ipk_) :: info
call psb_realloc(nr,ag%w,info)
if (info /= psb_success_) return
ag%w = done
!call ag%set_c_default_w()
end subroutine amg_s_bld_default_w
subroutine amg_s_set_prm_c_default_w(ag)
use psb_realloc_mod
use iso_c_binding
implicit none
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
integer(psb_ipk_) :: info
!write(0,*) 'prm_c_deafult_w '
call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
end subroutine amg_s_set_prm_c_default_w
subroutine amg_s_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
use psb_realloc_mod
implicit none
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
integer(psb_lpk_), intent(in) :: ilaggr(:)
real(psb_spk_), intent(in) :: valaggr(:)
integer(psb_ipk_), intent(in) :: nx
integer(psb_ipk_) :: info,i,j
! The vector was already fixed in the call to BCMatch.
!write(0,*) 'Executing bld_wnxt ',nx
call psb_realloc(nx,ag%w_nxt,info)
end subroutine amg_s_parmatch_bld_wnxt
function amg_s_parmatch_aggregator_fmt() result(val)
implicit none
character(len=32) :: val
val = "Parallel Matching aggregation"
end function amg_s_parmatch_aggregator_fmt
function amg_s_parmatch_aggregator_xt_desc() result(val)
implicit none
logical :: val
val = .true.
end function amg_s_parmatch_aggregator_xt_desc
function amg_s_parmatch_aggregator_sizeof(ag) result(val)
use psb_realloc_mod
implicit none
class(amg_s_parmatch_aggregator_type), intent(in) :: ag
integer(psb_epk_) :: val
val = 4
val = val + psb_size(ag%w) + psb_size(ag%w_nxt)
if (allocated(ag%ac)) val = val + ag%ac%sizeof()
if (allocated(ag%base_a)) val = val + ag%base_a%sizeof()
if (allocated(ag%prol)) val = val + ag%prol%sizeof()
if (allocated(ag%restr)) val = val + ag%restr%sizeof()
if (allocated(ag%desc_ac)) val = val + ag%desc_ac%sizeof()
if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
end function amg_s_parmatch_aggregator_sizeof
subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
implicit none
class(amg_s_parmatch_aggregator_type), intent(in) :: ag
type(amg_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps
write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)'
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info,prefix=prefix)
return
end subroutine amg_s_parmatch_aggregator_descr
function is_legal_malg(alg) result(val)
logical :: val
integer(psb_ipk_) :: alg
val = (0==alg)
end function is_legal_malg
function is_legal_csize(csize) result(val)
logical :: val
integer(psb_ipk_) :: csize
val = ((-1==csize).or.(csize >0))
end function is_legal_csize
function is_legal_nsweeps(nsw) result(val)
logical :: val
integer(psb_ipk_) :: nsw
val = (1<=nsw)
end function is_legal_nsweeps
function is_legal_nlevels(nlv) result(val)
logical :: val
integer(psb_ipk_) :: nlv
val = (1<=nlv)
end function is_legal_nlevels
subroutine amg_s_parmatch_aggregator_update_next(ag,agnext,info)
use psb_realloc_mod
implicit none
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
class(amg_s_base_aggregator_type), target, intent(inout) :: agnext
integer(psb_ipk_), intent(out) :: info
!
!
select type(agnext)
class is (amg_s_parmatch_aggregator_type)
if (.not.is_legal_malg(agnext%matching_alg)) &
& agnext%matching_alg = ag%matching_alg
if (.not.is_legal_nsweeps(agnext%n_sweeps))&
& agnext%n_sweeps = ag%n_sweeps
!!$ if (.not.is_legal_csize(agnext%max_csize))&
!!$ & agnext%max_csize = ag%max_csize
!!$ if (.not.is_legal_nlevels(agnext%max_nlevels))&
!!$ & agnext%max_nlevels = ag%max_nlevels
! Is this going to generate shallow copies/memory leaks/double frees?
! To be investigated further.
call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
call agnext%set_c_default_w()
if (ag%unsmoothed_hierarchy) then
agnext%unsmoothed_hierarchy = .true.
call move_alloc(ag%rwdesc,agnext%base_desc)
call move_alloc(ag%rwa,agnext%base_a)
end if
class default
! What should we do here?
end select
info = 0
end subroutine amg_s_parmatch_aggregator_update_next
subroutine amg_s_parmatch_aggr_csetc(ag,what,val,info,idx)
Implicit None
! Arguments
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, iwhat
character(len=20) :: name='s_parmatch_aggr_cseti'
info = psb_success_
! For now we ignore IDX
select case(psb_toupper(trim(what)))
case('PRMC_REPRODUCIBLE_MATCHING')
select case(psb_toupper(trim(val)))
case('F','FALSE')
ag%reproducible_matching = .false.
case('REPRODUCIBLE','TRUE','T')
ag%reproducible_matching =.true.
end select
case('PRMC_NEED_SYMMETRIZE')
select case(psb_toupper(trim(val)))
case('FALSE','F')
ag%need_symmetrize = .false.
case('SYMMETRIZE','TRUE','T')
ag%need_symmetrize =.true.
end select
case('PRMC_UNSMOOTHED_HIERARCHY')
select case(psb_toupper(trim(val)))
case('F','FALSE')
ag%unsmoothed_hierarchy = .false.
case('T','TRUE')
ag%unsmoothed_hierarchy =.true.
end select
case default
! Do nothing
end select
return
end subroutine amg_s_parmatch_aggr_csetc
subroutine amg_s_parmatch_aggr_cseti(ag,what,val,info,idx)
Implicit None
! Arguments
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, iwhat
character(len=20) :: name='s_parmatch_aggr_cseti'
info = psb_success_
! For now we ignore IDX
select case(psb_toupper(trim(what)))
case('PRMC_MATCH_ALG')
ag%matching_alg=val
case('PRMC_SWEEPS')
ag%n_sweeps=val
case('AGGR_SIZE')
ag%orig_aggr_size = val
ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
case('PRMC_W_SIZE')
call ag%bld_default_w(val)
case('PRMC_REPRODUCIBLE_MATCHING')
ag%reproducible_matching = (val == 1)
case('PRMC_NEED_SYMMETRIZE')
ag%need_symmetrize = (val == 1)
case('PRMC_UNSMOOTHED_HIERARCHY')
ag%unsmoothed_hierarchy = (val == 1)
case default
! Do nothing
end select
return
end subroutine amg_s_parmatch_aggr_cseti
subroutine amg_s_parmatch_aggr_set_default(ag)
Implicit None
! Arguments
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
character(len=20) :: name='s_parmatch_aggr_set_default'
call ag%amg_s_base_aggregator_type%default()
ag%matching_alg = 0
ag%n_sweeps = 1
ag%jacobi_sweeps = 0
!!$ ag%max_nlevels = 36
!!$ ag%max_csize = -1
!
! Apparently BootCMatch works better
! by keeping all entries
!
ag%do_clean_zeros = .false.
return
end subroutine amg_s_parmatch_aggr_set_default
subroutine amg_s_parmatch_aggregator_free(ag,info)
use iso_c_binding
implicit none
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
integer(psb_ipk_), intent(out) :: info
info = 0
if ((info == 0).and.allocated(ag%w)) deallocate(ag%w,stat=info)
if ((info == 0).and.allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info)
if ((info == 0).and.allocated(ag%prol)) then
call ag%prol%free(); deallocate(ag%prol,stat=info)
end if
if ((info == 0).and.allocated(ag%restr)) then
call ag%restr%free(); deallocate(ag%restr,stat=info)
end if
if ((info == 0).and.allocated(ag%ac)) then
call ag%ac%free(); deallocate(ag%ac,stat=info)
end if
if ((info == 0).and.allocated(ag%base_a)) then
call ag%base_a%free(); deallocate(ag%base_a,stat=info)
end if
if ((info == 0).and.allocated(ag%rwa)) then
call ag%rwa%free(); deallocate(ag%rwa,stat=info)
end if
if ((info == 0).and.allocated(ag%desc_ac)) then
call ag%desc_ac%free(info); deallocate(ag%desc_ac,stat=info)
end if
if ((info == 0).and.allocated(ag%desc_ax)) then
call ag%desc_ax%free(info); deallocate(ag%desc_ax,stat=info)
end if
if ((info == 0).and.allocated(ag%base_desc)) then
call ag%base_desc%free(info); deallocate(ag%base_desc,stat=info)
end if
if ((info == 0).and.allocated(ag%rwdesc)) then
call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
end if
end subroutine amg_s_parmatch_aggregator_free
subroutine amg_s_parmatch_aggregator_clone(ag,agnext,info)
implicit none
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
class(amg_s_base_aggregator_type), allocatable, intent(inout) :: agnext
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(agnext)) then
call agnext%free(info)
if (info == 0) deallocate(agnext,stat=info)
end if
if (info /= 0) return
allocate(agnext,source=ag,stat=info)
select type(agnext)
class is (amg_s_parmatch_aggregator_type)
call agnext%set_c_default_w()
class default
! Should never ever get here
info = -1
end select
end subroutine amg_s_parmatch_aggregator_clone
subroutine amg_s_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
& op_restr,op_prol,map,info)
use psb_base_mod
implicit none
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
type(psb_desc_type), intent(in), target :: desc_a, desc_ac
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_sspmat_type), intent(inout) :: op_prol, op_restr
type(psb_slinmap_type), intent(out) :: map
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_parmatch_aggregator_bld_map'
call psb_erractionsave(err_act)
!
! Copy the prolongation/restriction matrices into the descriptor map.
! op_restr => PR^T i.e. restriction operator
! op_prol => PR i.e. prolongation operator
!
! For parmatch have an explicit copy of the descriptors
!
if (allocated(ag%desc_ax)) then
!!$ write(0,*) 'Building linmap with ag%desc_ax ',ag%desc_ax%get_local_rows(),ag%desc_ax%get_local_cols(),&
!!$ & desc_ac%get_local_rows(),desc_ac%get_local_cols()
map = psb_linmap(psb_map_gen_linear_,ag%desc_ax,&
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
else
map = psb_linmap(psb_map_gen_linear_,desc_a,&
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
end if
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_s_parmatch_aggregator_bld_map
#endif
end module amg_s_parmatch_aggregator_mod
+66 -4
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -40,7 +40,7 @@
! Module: amg_s_prec_mod
!
! This module defines the user interfaces to the real/complex, single/double
! precision versions of the user-level AMG4PSBLAS routines.
! precision versions of the user-level MLD2P4 routines.
!
module amg_s_prec_mod
@@ -55,7 +55,12 @@ module amg_s_prec_mod
use amg_s_ainv_solver
use amg_s_invk_solver
use amg_s_invt_solver
use amg_s_krm_solver
interface amg_precset
module procedure amg_s_iprecsetsm, amg_s_iprecsetsv, &
& amg_s_cprecseti, amg_s_cprecsetc, amg_s_cprecsetr, &
& amg_s_iprecsetag
end interface amg_precset
interface amg_extprol_bld
subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
@@ -77,4 +82,61 @@ module amg_s_prec_mod
end subroutine amg_s_extprol_bld
end interface amg_extprol_bld
contains
subroutine amg_s_iprecsetsm(p,val,info,pos)
type(amg_sprec_type), intent(inout) :: p
class(amg_s_base_smoother_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(val,info,pos=pos)
end subroutine amg_s_iprecsetsm
subroutine amg_s_iprecsetsv(p,val,info,pos)
type(amg_sprec_type), intent(inout) :: p
class(amg_s_base_solver_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(val,info, pos=pos)
end subroutine amg_s_iprecsetsv
subroutine amg_s_iprecsetag(p,val,info,pos)
type(amg_sprec_type), intent(inout) :: p
class(amg_s_base_aggregator_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(val,info, pos=pos)
end subroutine amg_s_iprecsetag
subroutine amg_s_cprecseti(p,what,val,info,pos)
type(amg_sprec_type), intent(inout) :: p
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(what,val,info,pos=pos)
end subroutine amg_s_cprecseti
subroutine amg_s_cprecsetr(p,what,val,info,pos)
type(amg_sprec_type), intent(inout) :: p
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(what,val,info,pos=pos)
end subroutine amg_s_cprecsetr
subroutine amg_s_cprecsetc(p,what,val,info,pos)
type(amg_sprec_type), intent(inout) :: p
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
call p%set(what,val,info,pos=pos)
end subroutine amg_s_cprecsetc
end module amg_s_prec_mod
+17 -35
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -66,7 +66,7 @@ module amg_s_prec_type
!
! This is the data type containing all the information about the multilevel
! preconditioner ('d', 's', 'c' and 'z', according to the real/complex,
! single/double precision version of AMG4PSBLAS).
! single/double precision version of MLD2P4).
! It consists of an array of 'one-level' intermediate data structures
! of type amg_sonelev_type, each containing the information needed to apply
! the smoothing and the coarse-space correction at a generic level. RT is the
@@ -155,16 +155,13 @@ 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,iout,root)
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(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
@@ -427,22 +424,11 @@ contains
end if
end function amg_s_get_nzeros
function amg_sprec_sizeof(prec, global) result(val)
function amg_sprec_sizeof(prec) result(val)
implicit none
class(amg_sprec_type), intent(in) :: prec
logical, intent(in), optional :: global
integer(psb_epk_) :: val
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
type(psb_ctxt_type) :: ctxt
logical :: global_
if (present(global)) then
global_ = global
else
global_ = .false.
end if
val = 0
val = val + psb_sizeof_ip
if (allocated(prec%precv)) then
@@ -450,11 +436,6 @@ contains
val = val + prec%precv(i)%sizeof()
end do
end if
if (global_) then
ctxt = prec%ctxt
call psb_sum(ctxt,val)
end if
end function amg_sprec_sizeof
!
@@ -757,15 +738,16 @@ contains
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
integer(psb_ipk_) :: i, j, il1, iln, lev
type(psb_ctxt_type) :: ctxt
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np, iproc_
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_
info = 0
ctxt = prec%ctxt
call psb_info(ctxt,iam,np)
icontxt = prec%ctxt
call psb_info(icontxt,iam,np)
iln = size(prec%precv)
if (present(istart)) then
il1 = max(1,istart)
@@ -830,13 +812,13 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, ln, lev
type(psb_ctxt_type) :: ctxt
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np
info = psb_success_
select type(pout => precout)
class is (amg_sprec_type)
pout%ctxt = prec%ctxt
pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps
if (allocated(prec%precv)) then
@@ -852,8 +834,8 @@ contains
if (info == psb_success_) then
pout%precv(lev)%base_a => pout%precv(lev)%ac
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
end if
end do
end if
@@ -893,8 +875,8 @@ contains
do i=2, size(b%precv)
b%precv(i)%base_a => b%precv(i)%ac
b%precv(i)%base_desc => b%precv(i)%desc_ac
b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
end do
else
@@ -1,14 +1,11 @@
!
!
!
!
! 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
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
@@ -55,14 +52,14 @@
! 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
! 3. The name of the MLD2P4 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
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 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
@@ -73,16 +70,16 @@
!
!
!
! File: amg_s_krm_solver_mod.f90
! File: amg_s_rkr_solver_mod.f90
!
! Module: amg_s_krm_solver_mod
! Module: amg_s_rkr_solver_mod
!
module amg_s_krm_solver
module amg_s_rkr_solver
use amg_s_base_solver_mod
use amg_s_prec_type
type, extends(amg_s_base_solver_type) :: amg_s_krm_solver_type
type, extends(amg_s_base_solver_type) :: amg_s_rkr_solver_type
!
logical :: global
character(len=16) :: method, kprec, sub_solve
@@ -97,46 +94,46 @@ module amg_s_krm_solver
contains
!
!
procedure, pass(sv) :: dump => s_krm_solver_dmp
procedure, pass(sv) :: check => s_krm_solver_check
procedure, pass(sv) :: clone => s_krm_solver_clone
procedure, pass(sv) :: clone_settings => s_krm_solver_clone_settings
procedure, pass(sv) :: cnv => s_krm_solver_cnv
procedure, pass(sv) :: apply_v => amg_s_krm_solver_apply_vect
procedure, pass(sv) :: apply_a => amg_s_krm_solver_apply
procedure, pass(sv) :: clear_data => s_krm_solver_clear_data
procedure, pass(sv) :: free => s_krm_solver_free
procedure, pass(sv) :: cseti => s_krm_solver_cseti
procedure, pass(sv) :: csetc => s_krm_solver_csetc
procedure, pass(sv) :: csetr => s_krm_solver_csetr
procedure, pass(sv) :: sizeof => s_krm_solver_sizeof
procedure, pass(sv) :: get_nzeros => s_krm_solver_get_nzeros
!procedure, nopass :: get_id => s_krm_solver_get_id
procedure, pass(sv) :: is_global => s_krm_solver_is_global
procedure, nopass :: is_iterative => s_krm_solver_is_iterative
procedure, pass(sv) :: dump => s_rkr_solver_dmp
procedure, pass(sv) :: check => s_rkr_solver_check
procedure, pass(sv) :: clone => s_rkr_solver_clone
procedure, pass(sv) :: clone_settings => s_rkr_solver_clone_settings
procedure, pass(sv) :: cnv => s_rkr_solver_cnv
procedure, pass(sv) :: apply_v => amg_s_rkr_solver_apply_vect
procedure, pass(sv) :: apply_a => amg_s_rkr_solver_apply
procedure, pass(sv) :: clear_data => s_rkr_solver_clear_data
procedure, pass(sv) :: free => s_rkr_solver_free
procedure, pass(sv) :: cseti => s_rkr_solver_cseti
procedure, pass(sv) :: csetc => s_rkr_solver_csetc
procedure, pass(sv) :: csetr => s_rkr_solver_csetr
procedure, pass(sv) :: sizeof => s_rkr_solver_sizeof
procedure, pass(sv) :: get_nzeros => s_rkr_solver_get_nzeros
!procedure, nopass :: get_id => s_rkr_solver_get_id
procedure, pass(sv) :: is_global => s_rkr_solver_is_global
procedure, nopass :: is_iterative => s_rkr_solver_is_iterative
!
! These methods are specific for the new solver type
! and therefore need to be overridden
!
procedure, pass(sv) :: descr => s_krm_solver_descr
procedure, pass(sv) :: default => s_krm_solver_default
procedure, pass(sv) :: build => amg_s_krm_solver_bld
procedure, nopass :: get_fmt => s_krm_solver_get_fmt
end type amg_s_krm_solver_type
procedure, pass(sv) :: descr => s_rkr_solver_descr
procedure, pass(sv) :: default => s_rkr_solver_default
procedure, pass(sv) :: build => amg_s_rkr_solver_bld
procedure, nopass :: get_fmt => s_rkr_solver_get_fmt
end type amg_s_rkr_solver_type
private :: s_krm_solver_get_fmt, s_krm_solver_descr, s_krm_solver_default
private :: s_rkr_solver_get_fmt, s_rkr_solver_descr, s_rkr_solver_default
interface
subroutine amg_s_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
subroutine amg_s_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,wv,info,init,initu)
import :: psb_desc_type, amg_s_krm_solver_type, psb_s_vect_type, psb_spk_, &
import :: psb_desc_type, amg_s_rkr_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_krm_solver_type), intent(inout) :: sv
class(amg_s_rkr_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
@@ -146,17 +143,17 @@ module amg_s_krm_solver
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu
end subroutine amg_s_krm_solver_apply_vect
end subroutine amg_s_rkr_solver_apply_vect
end interface
interface
subroutine amg_s_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
subroutine amg_s_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
import :: psb_desc_type, amg_s_krm_solver_type, psb_s_vect_type, psb_spk_, &
import :: psb_desc_type, amg_s_rkr_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_krm_solver_type), intent(inout) :: sv
class(amg_s_rkr_solver_type), intent(inout) :: sv
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta
@@ -165,24 +162,24 @@ module amg_s_krm_solver
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
real(psb_spk_),intent(inout), optional :: initu(:)
end subroutine amg_s_krm_solver_apply
end subroutine amg_s_rkr_solver_apply
end interface
interface
subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_s_krm_solver_type, psb_s_vect_type, psb_spk_, &
subroutine amg_s_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_s_rkr_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_krm_solver_type), intent(inout) :: sv
class(amg_s_rkr_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_krm_solver_bld
end subroutine amg_s_rkr_solver_bld
end interface
@@ -190,12 +187,12 @@ contains
!
!
subroutine s_krm_solver_default(sv)
subroutine s_rkr_solver_default(sv)
Implicit None
! Arguments
class(amg_s_krm_solver_type), intent(inout) :: sv
class(amg_s_rkr_solver_type), intent(inout) :: sv
sv%method = 'bicgstab'
sv%kprec = 'bjac'
@@ -210,42 +207,42 @@ contains
sv%global = .false.
return
end subroutine s_krm_solver_default
end subroutine s_rkr_solver_default
function s_krm_solver_get_nzeros(sv) result(val)
function s_rkr_solver_get_nzeros(sv) result(val)
implicit none
! Arguments
class(amg_s_krm_solver_type), intent(in) :: sv
class(amg_s_rkr_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
val = sv%prec%get_nzeros()
return
end function s_krm_solver_get_nzeros
end function s_rkr_solver_get_nzeros
function s_krm_solver_sizeof(sv) result(val)
function s_rkr_solver_sizeof(sv) result(val)
implicit none
! Arguments
class(amg_s_krm_solver_type), intent(in) :: sv
class(amg_s_rkr_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
return
end function s_krm_solver_sizeof
end function s_rkr_solver_sizeof
subroutine s_krm_solver_check(sv,info)
subroutine s_rkr_solver_check(sv,info)
Implicit None
! Arguments
class(amg_s_krm_solver_type), intent(inout) :: sv
class(amg_s_rkr_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_krm_solver_check'
character(len=20) :: name='s_rkr_solver_check'
call psb_erractionsave(err_act)
info = psb_success_
@@ -259,36 +256,36 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine s_krm_solver_check
end subroutine s_rkr_solver_check
subroutine s_krm_solver_cseti(sv,what,val,info,idx)
subroutine s_rkr_solver_cseti(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_s_krm_solver_type), intent(inout) :: sv
class(amg_s_rkr_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_krm_solver_cseti'
character(len=20) :: name='s_rkr_solver_cseti'
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(trim(what)))
case('KRM_IRST')
case('RKR_IRST')
sv%irst = val
case('KRM_ISTOPC')
case('RKR_ISTOPC')
sv%istopc = val
case('KRM_ITMAX')
case('RKR_ITMAX')
sv%itmax = val
case('KRM_ITRACE')
case('RKR_ITRACE')
sv%itrace = val
case('KRM_SUB_SOLVE')
case('RKR_SUB_SOLVE')
sv%i_sub_solve = val
case('KRM_FILLIN')
case('RKR_FILLIN')
sv%fillin = val
case default
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
@@ -299,33 +296,33 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine s_krm_solver_cseti
end subroutine s_rkr_solver_cseti
subroutine s_krm_solver_csetc(sv,what,val,info,idx)
subroutine s_rkr_solver_csetc(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_s_krm_solver_type), intent(inout) :: sv
class(amg_s_rkr_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_krm_solver_csetc'
character(len=20) :: name='s_rkr_solver_csetc'
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(trim(what)))
case('KRM_METHOD')
case('RKR_METHOD')
sv%method = psb_toupper(trim(val))
case('KRM_KPREC')
case('RKR_KPREC')
sv%kprec = psb_toupper(trim(val))
case('KRM_SUB_SOLVE')
case('RKR_SUB_SOLVE')
sv%sub_solve = psb_toupper(trim(val))
case('KRM_GLOBAL')
case('RKR_GLOBAL')
select case(psb_toupper(trim(val)))
case('LOCAL','FALSE')
sv%global = .false.
@@ -348,26 +345,26 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine s_krm_solver_csetc
end subroutine s_rkr_solver_csetc
subroutine s_krm_solver_csetr(sv,what,val,info,idx)
subroutine s_rkr_solver_csetr(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_s_krm_solver_type), intent(inout) :: sv
class(amg_s_rkr_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_krm_solver_csetr'
character(len=20) :: name='s_rkr_solver_csetr'
call psb_erractionsave(err_act)
info = psb_success_
select case(psb_toupper(what))
case('KRM_EPS')
case('RKR_EPS')
sv%eps = val
case default
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
@@ -378,18 +375,18 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine s_krm_solver_csetr
end subroutine s_rkr_solver_csetr
subroutine s_krm_solver_clear_data(sv,info)
subroutine s_rkr_solver_clear_data(sv,info)
use psb_base_mod, only : psb_exit
Implicit None
! Arguments
class(amg_s_krm_solver_type), intent(inout) :: sv
class(amg_s_rkr_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: l_ctxt
character(len=20) :: name='s_krm_solver_free'
character(len=20) :: name='s_rkr_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
@@ -406,19 +403,19 @@ contains
nullify(sv%a)
call psb_erractionrestore(err_act)
return
end subroutine s_krm_solver_clear_data
end subroutine s_rkr_solver_clear_data
subroutine s_krm_solver_free(sv,info)
subroutine s_rkr_solver_free(sv,info)
use psb_base_mod, only : psb_exit
Implicit None
! Arguments
class(amg_s_krm_solver_type), intent(inout) :: sv
class(amg_s_rkr_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: l_ctxt
character(len=20) :: name='s_krm_solver_free'
character(len=20) :: name='s_rkr_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
@@ -427,31 +424,29 @@ contains
call psb_erractionrestore(err_act)
return
end subroutine s_krm_solver_free
end subroutine s_rkr_solver_free
function s_krm_solver_get_fmt() result(val)
function s_rkr_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "KRM solver"
end function s_krm_solver_get_fmt
val = "RKR solver"
end function s_rkr_solver_get_fmt
subroutine s_krm_solver_descr(sv,info,iout,coarse,prefix)
subroutine s_rkr_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_s_krm_solver_type), intent(in) :: sv
class(amg_s_rkr_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'
character(len=20), parameter :: name='amg_s_rkr_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -460,33 +455,34 @@ 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_,*) ' Recursive Krylov solver (global)'
else
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
write(iout_,*) ' Recursive Krylov solver (local) '
end if
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(iout_,info,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
9999 call psb_error_handler(err_act)
return
end subroutine s_krm_solver_descr
end subroutine s_rkr_solver_descr
subroutine s_krm_solver_cnv(sv,info,amold,vmold,imold)
subroutine s_rkr_solver_cnv(sv,info,amold,vmold,imold)
implicit none
class(amg_s_krm_solver_type), intent(inout) :: sv
class(amg_s_rkr_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
@@ -494,13 +490,13 @@ contains
call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
end subroutine s_krm_solver_cnv
end subroutine s_rkr_solver_cnv
subroutine s_krm_solver_clone(sv,svout,info)
subroutine s_rkr_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(amg_s_krm_solver_type), intent(inout) :: sv
class(amg_s_rkr_solver_type), intent(inout) :: sv
class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
@@ -509,7 +505,7 @@ contains
call svout%free(info)
allocate(svout,stat=info,mold=sv)
select type(so=>svout)
class is(amg_s_krm_solver_type)
class is(amg_s_rkr_solver_type)
so%method = sv%method
so%kprec = sv%kprec
so%sub_solve = sv%sub_solve
@@ -528,21 +524,21 @@ contains
info = psb_err_internal_error_
end select
end subroutine s_krm_solver_clone
end subroutine s_rkr_solver_clone
subroutine s_krm_solver_clone_settings(sv,svout,info)
subroutine s_rkr_solver_clone_settings(sv,svout,info)
Implicit None
! Arguments
class(amg_s_krm_solver_type), intent(inout) :: sv
class(amg_s_rkr_solver_type), intent(inout) :: sv
class(amg_s_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
info = psb_success_
select type(so=>svout)
class is(amg_s_krm_solver_type)
class is(amg_s_rkr_solver_type)
so%method = sv%method
so%kprec = sv%kprec
so%sub_solve = sv%sub_solve
@@ -558,11 +554,11 @@ contains
info = psb_err_internal_error_
end select
end subroutine s_krm_solver_clone_settings
end subroutine s_rkr_solver_clone_settings
subroutine s_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
subroutine s_rkr_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
implicit none
class(amg_s_krm_solver_type), intent(in) :: sv
class(amg_s_rkr_solver_type), intent(in) :: sv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
@@ -572,23 +568,23 @@ contains
call sv%prec%dump(info,prefix=prefix,head=head)
end subroutine s_krm_solver_dmp
end subroutine s_rkr_solver_dmp
!
! Notify whether KRM is used as a global solver
! Notify whether RKR is used as a global solver
!
function s_krm_solver_is_global(sv) result(val)
function s_rkr_solver_is_global(sv) result(val)
implicit none
class(amg_s_krm_solver_type), intent(in) :: sv
class(amg_s_rkr_solver_type), intent(in) :: sv
logical :: val
val = (sv%global)
end function s_krm_solver_is_global
end function s_rkr_solver_is_global
!
function s_krm_solver_is_iterative() result(val)
function s_rkr_solver_is_iterative() result(val)
implicit none
logical :: val
val = .true.
end function s_krm_solver_is_iterative
end function s_rkr_solver_is_iterative
end module amg_s_krm_solver
end module amg_s_rkr_solver
+7 -14
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+6 -15
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+48 -50
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
@@ -61,9 +58,10 @@ module amg_z_ainv_solver
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
!!$ procedure, pass(sv) :: seti => amg_z_ainv_solver_seti
!!$ procedure, pass(sv) :: setc => amg_z_ainv_solver_setc
!!$ procedure, pass(sv) :: setr => amg_z_ainv_solver_setr
procedure, pass(sv) :: seti => amg_z_ainv_solver_seti
procedure, pass(sv) :: setc => amg_z_ainv_solver_setc
procedure, pass(sv) :: setr => amg_z_ainv_solver_setr
generic, public :: set => seti, setr, setc
procedure, pass(sv) :: descr => amg_z_ainv_solver_descr
procedure, pass(sv) :: default => z_ainv_solver_default
procedure, nopass :: stringval => z_ainv_stringval
@@ -161,44 +159,44 @@ module amg_z_ainv_solver
end subroutine amg_z_ainv_solver_csetr
end interface
!!$ interface
!!$ subroutine amg_z_ainv_solver_setc(sv,what,val,info)
!!$ import :: amg_z_ainv_solver_type, psb_ipk_
!!$ Implicit none
!!$ ! Arguments
!!$ class(amg_z_ainv_solver_type), intent(inout) :: sv
!!$ integer(psb_ipk_), intent(in) :: what
!!$ character(len=*), intent(in) :: val
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_z_ainv_solver_setc
!!$ end interface
!!$
!!$ interface
!!$ subroutine amg_z_ainv_solver_seti(sv,what,val,info)
!!$ import :: amg_z_ainv_solver_type, psb_ipk_
!!$ Implicit none
!!$ ! Arguments
!!$ class(amg_z_ainv_solver_type), intent(inout) :: sv
!!$ integer(psb_ipk_), intent(in) :: what
!!$ integer(psb_ipk_), intent(in) :: val
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_z_ainv_solver_seti
!!$ end interface
!!$
!!$ interface
!!$ subroutine amg_z_ainv_solver_setr(sv,what,val,info)
!!$ import :: amg_z_ainv_solver_type, psb_ipk_, psb_dpk_
!!$ Implicit none
!!$ ! Arguments
!!$ class(amg_z_ainv_solver_type), intent(inout) :: sv
!!$ integer(psb_ipk_), intent(in) :: what
!!$ real(psb_dpk_), intent(in) :: val
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_z_ainv_solver_setr
!!$ end interface
interface
subroutine amg_z_ainv_solver_setc(sv,what,val,info)
import :: amg_z_ainv_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_z_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_z_ainv_solver_setc
end interface
interface
subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_z_ainv_solver_seti(sv,what,val,info)
import :: amg_z_ainv_solver_type, psb_ipk_
Implicit none
! Arguments
class(amg_z_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_z_ainv_solver_seti
end interface
interface
subroutine amg_z_ainv_solver_setr(sv,what,val,info)
import :: amg_z_ainv_solver_type, psb_ipk_, psb_dpk_
Implicit none
! Arguments
class(amg_z_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
end subroutine amg_z_ainv_solver_setr
end interface
interface
subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
Implicit None
@@ -208,7 +206,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
+11 -18
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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)
+7 -14
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -126,7 +126,7 @@ module amg_z_base_aggregator_mod
& psb_z_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
implicit none
type(psb_z_csr_sparse_mat), intent(inout) :: a_csr
type(psb_desc_type), intent(inout) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: nlaggr(:)
type(amg_dml_parms), intent(inout) :: parms
type(psb_z_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -144,7 +144,7 @@ module amg_z_base_aggregator_mod
& psb_z_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
implicit none
type(psb_z_csr_sparse_mat), intent(inout) :: a_csr
type(psb_desc_type), intent(inout) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: nlaggr(:)
type(amg_dml_parms), intent(inout) :: parms
type(psb_z_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
@@ -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
+7 -10
View File
@@ -1,14 +1,11 @@
!
!
!
!
! AMG-AINV: Approximate Inverse plugin for
! 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
!
! (C) Copyright 2020
!
! Salvatore Filippone University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
+3 -4
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+4 -4
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+6 -13
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+8 -22
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+14 -28
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+1 -1
View File
@@ -2,7 +2,7 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
+5 -12
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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
+2 -2
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
+9 -16
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -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)
+3 -3
View File
@@ -2,9 +2,9 @@
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2021
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
@@ -39,7 +39,7 @@
!
! Module: amg_inner_mod
!
! This module defines the interfaces to inner AMG4PSBLAS routines.
! This module defines the interfaces to inner MLD2P4 routines.
! The interfaces of the user level routines are defined in amg_prec_mod.f90.
!
module amg_z_inner_mod

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