mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-07 07:04:59 +00:00
Compare commits
11
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
d96e747578 | ||
|
|
cbf455411e | ||
|
|
62f630175a | ||
|
|
90b2f47d3e | ||
|
|
95a2784b69 | ||
|
|
dbd62f603f | ||
|
|
ecac67c1cf | ||
|
|
29c6ac416c | ||
|
|
aece94c0fd | ||
|
|
838eaa4d83 | ||
|
|
dd1f335d78 |
@@ -1,6 +1,6 @@
|
||||
$Format:%d%n%n$
|
||||
# Fall back version, probably last release:
|
||||
1.2.1
|
||||
1.2.0
|
||||
|
||||
# AMG4PSBLAS version file.
|
||||
#
|
||||
|
||||
+11
-8
@@ -13,10 +13,15 @@ endif()
|
||||
|
||||
|
||||
# Check for the installation path for psblas
|
||||
message(STATUS "psblas directory is ${PSBLAS_INSTALL_DIR};")
|
||||
#if(NOT DEFINED PSBLAS_INSTALL_DIR)
|
||||
# message(FATAL_ERROR "Please specify the path to the psblas installation directory using -DPSBLAS_INSTALL_DIR=<path>")
|
||||
#endif()
|
||||
message(STATUS "psblas directory is ${PSBLAS_INSTALL_DIR};;")
|
||||
|
||||
|
||||
message(STATUS "PSBLAS DIRECTORY INC ${INCDIR}; MOD ${MODDIR}; LIB ${LIBDIR};")
|
||||
|
||||
|
||||
#set(CMAKE_CXX_STANDARD 17) # Set cxx standard for the c++ part of the library
|
||||
|
||||
|
||||
@@ -26,7 +31,7 @@ find_package(psblas REQUIRED PATHS ${PSBLAS_INSTALL_DIR})
|
||||
if(NOT psblas_FOUND)
|
||||
message(FATAL_ERROR "PSBLAS not found!")
|
||||
else()
|
||||
message(STATUS "Found PSBLAS: ${PSBLAS_LIBRARIES}")
|
||||
message(STATUS "Found PSBLAS: ${psblas_LIBRARIES}")
|
||||
endif()
|
||||
|
||||
if(CMAKE_BUILD_TYPE STREQUAL "Debug")
|
||||
@@ -37,9 +42,9 @@ if(CMAKE_BUILD_TYPE STREQUAL "Debug")
|
||||
message(STATUS "Fortran and CXX debug flags added: -g")
|
||||
endif()
|
||||
|
||||
string(APPEND CMAKE_Fortran_FLAGS " -O2")
|
||||
string(APPEND CMAKE_CXX_FLAGS " -O2")
|
||||
message(STATUS "Fortran and CXX optimization flags added: -O2")
|
||||
string(APPEND CMAKE_Fortran_FLAGS " -O2")
|
||||
string(APPEND CMAKE_CXX_FLAGS " -O2")
|
||||
message(STATUS "Fortran and CXX optimization flags added: -O2")
|
||||
|
||||
|
||||
|
||||
@@ -425,9 +430,7 @@ target_include_directories(amgcbind PUBLIC ${INCDIR} ${MODDIR})
|
||||
target_link_libraries(amgcbind
|
||||
#PUBLIC ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES} ${LAPACK95_LIBRARIES}
|
||||
#PUBLIC ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES} ${BLAS95_LIBRARIES}
|
||||
PUBLIC amgprec psblas::util psblas::linsolve psblas::prec
|
||||
psblas::ext psblas::cbind psblas::base)
|
||||
#TODO check actual libraries needed
|
||||
PUBLIC amgprec psblas::util psblas::linsolve psblas::prec psblas::ext psblas::cbind psblas::base) #TODO check actual libraries needed
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -7,7 +7,7 @@
|
||||
(C) Copyright 2025 Salvatore Filippone
|
||||
(C) Copyright 2025 Pasqua D'Ambra
|
||||
(C) Copyright 2025 Fabio Durastante
|
||||
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
|
||||
+1
-1
@@ -71,7 +71,7 @@ EXTRALIBS=@EXTRA_LIBS@
|
||||
|
||||
#
|
||||
AMGCDEFINES=$(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS)
|
||||
#$(PSBCDEFINES) $(MUMPSFLAGS)
|
||||
#$(PSBCDEFINES) $(MUMPSFLAGS)
|
||||
CDEFINES=$(AMGCDEFINES)
|
||||
AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
|
||||
FDEFINES=$(AMGFDEFINES)
|
||||
|
||||
@@ -19,7 +19,7 @@ libdir:
|
||||
amgobjs: mods
|
||||
cd amgprec && $(MAKE) objs
|
||||
|
||||
cbnd: amgobjs
|
||||
cbnd: mods
|
||||
cd cbind && $(MAKE) objs
|
||||
|
||||
install: all
|
||||
|
||||
@@ -509,7 +509,6 @@ set(AMG_amgprec_source_files
|
||||
impl/smoother/amg_s_base_smoother_free.f90
|
||||
impl/smoother/amg_d_jac_smoother_clone.f90
|
||||
impl/smoother/amg_d_jac_smoother_apply_vect.f90
|
||||
impl/smoother/amg_d_richards_smoother_impl.f90
|
||||
impl/smoother/amg_c_as_smoother_clear_data.f90
|
||||
impl/smoother/amg_s_poly_smoother_descr.f90
|
||||
impl/smoother/amg_z_as_smoother_cseti.f90
|
||||
@@ -774,7 +773,6 @@ set(AMG_amgprec_source_files
|
||||
amg_prec_mod.f90
|
||||
amg_d_gs_solver.f90
|
||||
amg_d_jac_smoother.f90
|
||||
amg_d_richards_smoother.f90
|
||||
amg_z_symdec_aggregator_mod.f90
|
||||
amg_s_gs_solver.f90
|
||||
amg_ainv_mod.f90
|
||||
|
||||
+5
-6
@@ -8,7 +8,7 @@ FINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(INCDIR) $(PSBLAS_INCLUDES)
|
||||
|
||||
|
||||
DMODOBJS=amg_d_prec_type.o \
|
||||
amg_d_inner_mod.o amg_d_ilu_solver.o amg_d_diag_solver.o amg_d_jac_smoother.o amg_d_as_smoother.o amg_d_richards_smoother.o \
|
||||
amg_d_inner_mod.o amg_d_ilu_solver.o amg_d_diag_solver.o amg_d_jac_smoother.o amg_d_as_smoother.o \
|
||||
amg_d_poly_smoother.o amg_d_poly_coeff_mod.o\
|
||||
amg_d_umf_solver.o amg_d_slu_solver.o amg_d_sludist_solver.o amg_d_id_solver.o\
|
||||
amg_d_base_solver_mod.o amg_d_base_smoother_mod.o amg_d_onelev_mod.o \
|
||||
@@ -58,8 +58,7 @@ MODOBJS=amg_base_prec_type.o amg_prec_type.o amg_prec_mod.o \
|
||||
$(SMODOBJS) $(DMODOBJS) $(CMODOBJS) $(ZMODOBJS)
|
||||
|
||||
|
||||
LOCAL_MODS=$(MODOBJS:.o=$(.mod)) amg_c_l1_diag_solver$(.mod) amg_s_l1_diag_solver$(.mod) \
|
||||
amg_d_l1_diag_solver$(.mod) amg_z_l1_diag_solver$(.mod)
|
||||
LOCAL_MODS=$(MODOBJS:.o=$(.mod))
|
||||
LIBNAME=libamg_prec.a
|
||||
|
||||
all: mods objs impld
|
||||
@@ -71,7 +70,7 @@ objs: mods impld
|
||||
impld: mods
|
||||
cd impl && $(MAKE)
|
||||
|
||||
lib: objs
|
||||
lib: mods impld
|
||||
cd impl && $(MAKE) lib
|
||||
$(AR) $(HERE)/$(LIBNAME) $(MODOBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
@@ -80,7 +79,7 @@ lib: objs
|
||||
|
||||
$(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
|
||||
|
||||
amg_base_prec_type.o: amg_config.h
|
||||
#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
|
||||
@@ -159,7 +158,7 @@ amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o amg_d_jac_solver.o: am
|
||||
|
||||
#amg_d_ilu_fact_mod.o: amg_base_prec_type.o amg_d_base_solver_mod.o
|
||||
#amg_d_ilu_solver.o amg_d_iluk_fact.o: amg_d_ilu_fact_mod.o
|
||||
amg_d_as_smoother.o amg_d_jac_smoother.o amg_d_richards_smoother.o: amg_d_base_smoother_mod.o
|
||||
amg_d_as_smoother.o amg_d_jac_smoother.o: amg_d_base_smoother_mod.o
|
||||
amg_d_jac_smoother.o: amg_d_diag_solver.o
|
||||
amg_dprecinit.o amg_dprecset.o: amg_d_diag_solver.o amg_d_ilu_solver.o \
|
||||
amg_d_umf_solver.o amg_d_as_smoother.o amg_d_jac_smoother.o \
|
||||
|
||||
@@ -84,7 +84,7 @@ module amg_base_prec_type
|
||||
character(len=*), parameter :: amg_version_string_ = "1.2.0"
|
||||
integer(psb_ipk_), parameter :: amg_version_major_ = 1
|
||||
integer(psb_ipk_), parameter :: amg_version_minor_ = 2
|
||||
integer(psb_ipk_), parameter :: amg_patchlevel_ = 1
|
||||
integer(psb_ipk_), parameter :: amg_patchlevel_ = 0
|
||||
|
||||
type amg_ml_parms
|
||||
integer(psb_ipk_) :: sweeps_pre, sweeps_post
|
||||
@@ -216,8 +216,7 @@ module amg_base_prec_type
|
||||
integer(psb_ipk_), parameter :: amg_l1_gs_ = 7
|
||||
integer(psb_ipk_), parameter :: amg_l1_fbgs_ = 8
|
||||
integer(psb_ipk_), parameter :: amg_poly_ = 9
|
||||
integer(psb_ipk_), parameter :: amg_richardson_ = 10
|
||||
integer(psb_ipk_), parameter :: amg_max_prec_ = 10
|
||||
integer(psb_ipk_), parameter :: amg_max_prec_ = 9
|
||||
!
|
||||
! Constants for pre/post signaling. Now only used internally
|
||||
!
|
||||
@@ -230,8 +229,7 @@ module amg_base_prec_type
|
||||
!
|
||||
! Legal values for entry: amg_sub_solve_
|
||||
!
|
||||
! Keep this fixed so sub-solver numeric IDs remain stable.
|
||||
integer(psb_ipk_), parameter :: amg_slv_delta_ = 10
|
||||
integer(psb_ipk_), parameter :: amg_slv_delta_ = amg_max_prec_+1
|
||||
integer(psb_ipk_), parameter :: amg_f_none_ = amg_slv_delta_+0
|
||||
integer(psb_ipk_), parameter :: amg_diag_scale_ = amg_slv_delta_+1
|
||||
integer(psb_ipk_), parameter :: amg_l1_diag_scale_ = amg_slv_delta_+2
|
||||
@@ -411,7 +409,7 @@ module amg_base_prec_type
|
||||
& 'none ','Jacobi ',&
|
||||
& 'L1-Jacobi ','none ','none ',&
|
||||
& 'none ','none ','L1-GS ',&
|
||||
& 'L1-FBGS ','Polynomial ', 'Richards ','Point Jacobi ',&
|
||||
& 'L1-FBGS ','Polynomial ','none ','Point Jacobi ',&
|
||||
& 'L1-Jacobi ','Gauss-Seidel ','ILU(n) ',&
|
||||
& 'MILU(n) ','ILU(t,n) ',&
|
||||
& 'SuperLU ','UMFPACK LU ',&
|
||||
@@ -577,8 +575,6 @@ contains
|
||||
val = amg_as_
|
||||
case('POLY')
|
||||
val = amg_poly_
|
||||
case('RICHARDSON','RICHARDS')
|
||||
val = amg_richardson_
|
||||
case('CHEB_4')
|
||||
val = amg_cheb_4_
|
||||
case('CHEB_4_OPT')
|
||||
@@ -1206,8 +1202,6 @@ contains
|
||||
pr_to_str='BJAC'
|
||||
case(amg_as_)
|
||||
pr_to_str='AS'
|
||||
case(amg_richardson_)
|
||||
pr_to_str='RICHARDS'
|
||||
end select
|
||||
|
||||
end function pr_to_str
|
||||
|
||||
@@ -103,7 +103,7 @@ module amg_c_ainv_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -225,7 +225,7 @@ module amg_c_ainv_solver
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_c_base_vect_type, psb_spk_, psb_ipk_
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
integer(psb_ipk_), intent(in) :: fillin,alg
|
||||
real(psb_spk_), intent(in) :: thresh
|
||||
type(psb_cspmat_type), intent(inout) :: wmat, zmat
|
||||
|
||||
@@ -230,7 +230,7 @@ module amg_c_as_smoother
|
||||
& psb_desc_type, psb_c_base_sparse_mat, psb_ipk_,&
|
||||
& psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_as_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -237,7 +237,7 @@ module amg_c_base_smoother_mod
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_base_smoother_type, psb_ipk_, psb_i_base_vect_type
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_base_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -170,7 +170,7 @@ module amg_c_base_solver_mod
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_base_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -119,7 +119,7 @@ module amg_c_diag_solver
|
||||
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_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -331,7 +331,7 @@ module amg_c_l1_diag_solver
|
||||
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_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_l1_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -181,7 +181,7 @@ module amg_c_gs_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_gs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -195,7 +195,7 @@ module amg_c_gs_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_bwgs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -123,7 +123,7 @@ contains
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -144,7 +144,7 @@ module amg_c_ilu_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_ilu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -56,7 +56,7 @@ module amg_c_inner_mod
|
||||
& psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
|
||||
import :: amg_cprec_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(amg_cprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -94,7 +94,7 @@ module amg_c_invk_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_invk_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -94,7 +94,7 @@ module amg_c_invt_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -151,7 +151,7 @@ module amg_c_jac_smoother
|
||||
import :: psb_desc_type, amg_c_jac_smoother_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
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -274,7 +274,7 @@ module amg_c_jac_smoother
|
||||
import :: psb_desc_type, amg_c_l1_jac_smoother_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_l1_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -143,7 +143,7 @@ module amg_c_jac_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -160,7 +160,7 @@ module amg_c_jac_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_l1_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -174,7 +174,7 @@ module amg_c_krm_solver
|
||||
& 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(inout), target :: a
|
||||
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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -163,7 +163,7 @@ module amg_c_mumps_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_mumps_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -311,7 +311,7 @@ module amg_c_prec_type
|
||||
& psb_c_base_sparse_mat, psb_c_base_vect_type, &
|
||||
& psb_i_base_vect_type, amg_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_cprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -323,15 +323,14 @@ module amg_c_prec_type
|
||||
end interface amg_precbld
|
||||
|
||||
interface amg_hierarchy_bld
|
||||
subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
|
||||
& amg_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_cprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: cpymat
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine amg_c_hierarchy_bld
|
||||
end interface amg_hierarchy_bld
|
||||
@@ -636,11 +635,6 @@ contains
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
call prec%precv(i)%free(info)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
end do
|
||||
deallocate(prec%precv,stat=info)
|
||||
end if
|
||||
@@ -1008,7 +1002,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
!
|
||||
! In AMG the DESC optional argument is ignored, since
|
||||
! In MLD the DESC optional argument is ignored, since
|
||||
! the necessary info is contained in the various entries of the
|
||||
! PRECV component.
|
||||
type(psb_desc_type), intent(in), optional :: desc
|
||||
|
||||
@@ -124,7 +124,7 @@ module amg_c_slu_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -17,8 +17,6 @@
|
||||
@CHAVEMUMPS@
|
||||
@CHAVEMUMPSMODULES@
|
||||
@CHAVEMUMPSINCLUDES@
|
||||
@CHAVEMUMPSVERSION@
|
||||
@CHAVEMUMPSVERSIONSTRING@
|
||||
@CXXMATCHBOXBIT@
|
||||
|
||||
|
||||
|
||||
@@ -103,7 +103,7 @@ module amg_d_ainv_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -225,7 +225,7 @@ module amg_d_ainv_solver
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, psb_ipk_
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
integer(psb_ipk_), intent(in) :: fillin,alg
|
||||
real(psb_dpk_), intent(in) :: thresh
|
||||
type(psb_dspmat_type), intent(inout) :: wmat, zmat
|
||||
|
||||
@@ -230,7 +230,7 @@ module amg_d_as_smoother
|
||||
& psb_desc_type, psb_d_base_sparse_mat, psb_ipk_,&
|
||||
& psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_as_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -237,7 +237,7 @@ module amg_d_base_smoother_mod
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_base_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -170,7 +170,7 @@ module amg_d_base_solver_mod
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_base_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -119,7 +119,7 @@ module amg_d_diag_solver
|
||||
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_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -331,7 +331,7 @@ module amg_d_l1_diag_solver
|
||||
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_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_l1_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -181,7 +181,7 @@ module amg_d_gs_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_gs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -195,7 +195,7 @@ module amg_d_gs_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_bwgs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -123,7 +123,7 @@ contains
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -144,7 +144,7 @@ module amg_d_ilu_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_ilu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -56,7 +56,7 @@ module amg_d_inner_mod
|
||||
& psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
|
||||
import :: amg_dprec_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(amg_dprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -94,7 +94,7 @@ module amg_d_invk_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_invk_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -94,7 +94,7 @@ module amg_d_invt_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -151,7 +151,7 @@ module amg_d_jac_smoother
|
||||
import :: psb_desc_type, amg_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -274,7 +274,7 @@ module amg_d_jac_smoother
|
||||
import :: psb_desc_type, amg_d_l1_jac_smoother_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_l1_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -143,7 +143,7 @@ module amg_d_jac_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -160,7 +160,7 @@ module amg_d_jac_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_l1_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -174,7 +174,7 @@ module amg_d_krm_solver
|
||||
& 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(inout), target :: a
|
||||
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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -163,7 +163,7 @@ module amg_d_mumps_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_mumps_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -420,7 +420,7 @@ subroutine d_mumps_solver_cseti(sv,what,val,info,idx)
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
select case(psb_toupper(what))
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
case('MUMPS_LOC_GLOB')
|
||||
sv%ipar(1) = val
|
||||
@@ -466,7 +466,7 @@ subroutine d_mumps_solver_csetr(sv,what,val,info,idx)
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
select case(psb_toupper(what))
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
case('MUMPS_RPAR_ENTRY')
|
||||
if(present(idx)) then
|
||||
|
||||
@@ -140,7 +140,7 @@ module amg_d_poly_smoother
|
||||
import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -311,7 +311,7 @@ module amg_d_prec_type
|
||||
& psb_d_base_sparse_mat, psb_d_base_vect_type, &
|
||||
& psb_i_base_vect_type, amg_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_dprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -323,15 +323,14 @@ module amg_d_prec_type
|
||||
end interface amg_precbld
|
||||
|
||||
interface amg_hierarchy_bld
|
||||
subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& amg_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_dprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: cpymat
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine amg_d_hierarchy_bld
|
||||
end interface amg_hierarchy_bld
|
||||
@@ -636,11 +635,6 @@ contains
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
call prec%precv(i)%free(info)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
end do
|
||||
deallocate(prec%precv,stat=info)
|
||||
end if
|
||||
@@ -1008,7 +1002,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
!
|
||||
! In AMG the DESC optional argument is ignored, since
|
||||
! In MLD the DESC optional argument is ignored, since
|
||||
! the necessary info is contained in the various entries of the
|
||||
! PRECV component.
|
||||
type(psb_desc_type), intent(in), optional :: desc
|
||||
|
||||
@@ -1,365 +0,0 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Daniela di Serafino
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
|
||||
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
! POSSIBILITY OF SUCH DAMAGE.
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_d_richards_smoother.f90
|
||||
!
|
||||
! Module: amg_d_richards_smoother
|
||||
!
|
||||
! This module defines:
|
||||
! the amg_d_richards_smoother_type data structure containing the
|
||||
! smoother for a preconditioned Richards iteration.
|
||||
! The smoother applies the iterative method:
|
||||
! x_{k+1} = x_k + omega * P^{-1} * (b - A * x_k)
|
||||
! where P is a preconditioner (the solver component) acting on the global matrix A.
|
||||
! This allows using distributed solvers like MUMPS on the full system.
|
||||
!
|
||||
module amg_d_richards_smoother
|
||||
|
||||
use amg_d_base_smoother_mod
|
||||
|
||||
type, extends(amg_d_base_smoother_type) :: amg_d_richards_smoother_type
|
||||
! The local solver component is inherited from the
|
||||
! parent type, but acts on the global matrix.
|
||||
! class(amg_d_base_solver_type), allocatable :: sv
|
||||
!
|
||||
type(psb_dspmat_type), pointer :: pa => null()
|
||||
integer(psb_lpk_) :: global_nnz_tot
|
||||
logical :: checkres
|
||||
logical :: printres
|
||||
integer(psb_ipk_) :: checkiter
|
||||
integer(psb_ipk_) :: printiter
|
||||
real(psb_dpk_) :: tol
|
||||
real(psb_dpk_) :: omega
|
||||
contains
|
||||
procedure, pass(sm) :: apply_v => amg_d_richards_smoother_apply_vect
|
||||
procedure, pass(sm) :: apply_a => amg_d_richards_smoother_apply
|
||||
procedure, pass(sm) :: dump => amg_d_richards_smoother_dmp
|
||||
procedure, pass(sm) :: build => amg_d_richards_smoother_bld
|
||||
procedure, pass(sm) :: cnv => amg_d_richards_smoother_cnv
|
||||
procedure, pass(sm) :: clone => amg_d_richards_smoother_clone
|
||||
procedure, pass(sm) :: clone_settings => amg_d_richards_smoother_clone_settings
|
||||
procedure, pass(sm) :: clear_data => amg_d_richards_smoother_clear_data
|
||||
procedure, pass(sm) :: free => d_richards_smoother_free
|
||||
procedure, pass(sm) :: cseti => amg_d_richards_smoother_cseti
|
||||
procedure, pass(sm) :: csetc => amg_d_richards_smoother_csetc
|
||||
procedure, pass(sm) :: csetr => amg_d_richards_smoother_csetr
|
||||
procedure, pass(sm) :: descr => amg_d_richards_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => d_richards_smoother_sizeof
|
||||
procedure, pass(sm) :: default => d_richards_smoother_default
|
||||
procedure, pass(sm) :: get_nzeros => d_richards_smoother_get_nzeros
|
||||
procedure, pass(sm) :: get_wrksz => d_richards_smoother_get_wrksize
|
||||
procedure, nopass :: get_fmt => d_richards_smoother_get_fmt
|
||||
procedure, nopass :: get_id => d_richards_smoother_get_id
|
||||
end type amg_d_richards_smoother_type
|
||||
|
||||
private :: d_richards_smoother_free, &
|
||||
& d_richards_smoother_sizeof, d_richards_smoother_get_nzeros, &
|
||||
& d_richards_smoother_get_fmt, d_richards_smoother_get_id, &
|
||||
& d_richards_smoother_get_wrksize
|
||||
|
||||
interface
|
||||
subroutine amg_d_richards_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
& sweeps,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_d_richards_smoother_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_
|
||||
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_richards_smoother_type), intent(inout) :: sm
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
integer(psb_ipk_), intent(in) :: sweeps
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_d_richards_smoother_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_richards_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
& sweeps,work,info,init,initu)
|
||||
import :: psb_desc_type, amg_d_richards_smoother_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
|
||||
& psb_ipk_
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_richards_smoother_type), intent(inout) :: sm
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
integer(psb_ipk_), intent(in) :: sweeps
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_d_richards_smoother_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_richards_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_d_richards_smoother_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_richards_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_richards_smoother_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_richards_smoother_cnv(sm,info,amold,vmold,imold)
|
||||
import :: amg_d_richards_smoother_type, psb_dpk_, &
|
||||
& psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
class(amg_d_richards_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_richards_smoother_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_richards_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dpk_, amg_d_richards_smoother_type, psb_epk_, psb_desc_type, &
|
||||
& psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_richards_smoother_type), intent(in) :: sm
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: smoother, solver, global_num
|
||||
end subroutine amg_d_richards_smoother_dmp
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_richards_smoother_clone(sm,smout,info)
|
||||
import :: amg_d_richards_smoother_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
class(amg_d_richards_smoother_type), intent(inout) :: sm
|
||||
class(amg_d_base_smoother_type), allocatable, intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_richards_smoother_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_richards_smoother_clone_settings(sm,smout,info)
|
||||
import :: amg_d_richards_smoother_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
class(amg_d_richards_smoother_type), intent(inout) :: sm
|
||||
class(amg_d_base_smoother_type), intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_richards_smoother_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_richards_smoother_clear_data(sm,info)
|
||||
import :: amg_d_richards_smoother_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
class(amg_d_richards_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_richards_smoother_clear_data
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_richards_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: amg_d_richards_smoother_type, psb_ipk_
|
||||
class(amg_d_richards_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_d_richards_smoother_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_richards_smoother_cseti(sm,what,val,info,idx)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dpk_, amg_d_richards_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_richards_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_d_richards_smoother_cseti
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_richards_smoother_csetc(sm,what,val,info,idx)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dpk_, amg_d_richards_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_richards_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_d_richards_smoother_csetc
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_richards_smoother_csetr(sm,what,val,info,idx)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dpk_, amg_d_richards_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_richards_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_d_richards_smoother_csetr
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_richards_smoother_free(sm,info)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_richards_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_richards_smoother_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%free(info)
|
||||
if (info == psb_success_) deallocate(sm%sv,stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
end if
|
||||
sm%pa => null()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_richards_smoother_free
|
||||
|
||||
function d_richards_smoother_sizeof(sm) result(val)
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_richards_smoother_type), intent(in) :: sm
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = psb_sizeof_lp
|
||||
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
|
||||
|
||||
return
|
||||
end function d_richards_smoother_sizeof
|
||||
|
||||
subroutine d_richards_smoother_default(sm)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_richards_smoother_type), intent(inout) :: sm
|
||||
|
||||
!
|
||||
! Default: Richards iteration with omega=1.0 and no residual check
|
||||
!
|
||||
sm%checkres = .false.
|
||||
sm%printres = .false.
|
||||
sm%checkiter = -1
|
||||
sm%printiter = -1
|
||||
sm%tol = 0
|
||||
sm%omega = 1.0d0
|
||||
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%default()
|
||||
end if
|
||||
|
||||
return
|
||||
end subroutine d_richards_smoother_default
|
||||
|
||||
function d_richards_smoother_get_nzeros(sm) result(val)
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_richards_smoother_type), intent(in) :: sm
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = 0
|
||||
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()
|
||||
|
||||
return
|
||||
end function d_richards_smoother_get_nzeros
|
||||
|
||||
function d_richards_smoother_get_wrksize(sm) result(val)
|
||||
implicit none
|
||||
class(amg_d_richards_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
! apply_vect uses tx, ty, tz mapped to wv(1:3)
|
||||
val = 3
|
||||
if (allocated(sm%sv)) val = val + sm%sv%get_wrksz()
|
||||
|
||||
end function d_richards_smoother_get_wrksize
|
||||
|
||||
function d_richards_smoother_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Richards smoother"
|
||||
end function d_richards_smoother_get_fmt
|
||||
|
||||
function d_richards_smoother_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_richardson_
|
||||
end function d_richards_smoother_get_id
|
||||
|
||||
end module amg_d_richards_smoother
|
||||
@@ -124,7 +124,7 @@ module amg_d_slu_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -259,7 +259,7 @@ contains
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
|
||||
@@ -163,7 +163,7 @@ module amg_d_umf_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -103,7 +103,7 @@ module amg_s_ainv_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -225,7 +225,7 @@ module amg_s_ainv_solver
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_s_base_vect_type, psb_spk_, psb_ipk_
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
integer(psb_ipk_), intent(in) :: fillin,alg
|
||||
real(psb_spk_), intent(in) :: thresh
|
||||
type(psb_sspmat_type), intent(inout) :: wmat, zmat
|
||||
|
||||
@@ -230,7 +230,7 @@ module amg_s_as_smoother
|
||||
& psb_desc_type, psb_s_base_sparse_mat, psb_ipk_,&
|
||||
& psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_as_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -237,7 +237,7 @@ module amg_s_base_smoother_mod
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_base_smoother_type, psb_ipk_, psb_i_base_vect_type
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_base_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -170,7 +170,7 @@ module amg_s_base_solver_mod
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_base_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -119,7 +119,7 @@ module amg_s_diag_solver
|
||||
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_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -331,7 +331,7 @@ module amg_s_l1_diag_solver
|
||||
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_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_l1_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -181,7 +181,7 @@ module amg_s_gs_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_gs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -195,7 +195,7 @@ module amg_s_gs_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_bwgs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -123,7 +123,7 @@ contains
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -144,7 +144,7 @@ module amg_s_ilu_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_ilu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -56,7 +56,7 @@ module amg_s_inner_mod
|
||||
& psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
|
||||
import :: amg_sprec_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(amg_sprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -94,7 +94,7 @@ module amg_s_invk_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_invk_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -94,7 +94,7 @@ module amg_s_invt_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -151,7 +151,7 @@ module amg_s_jac_smoother
|
||||
import :: psb_desc_type, amg_s_jac_smoother_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -274,7 +274,7 @@ module amg_s_jac_smoother
|
||||
import :: psb_desc_type, amg_s_l1_jac_smoother_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_l1_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -143,7 +143,7 @@ module amg_s_jac_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -160,7 +160,7 @@ module amg_s_jac_solver
|
||||
& 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(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_l1_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -174,7 +174,7 @@ module amg_s_krm_solver
|
||||
& 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(inout), target :: a
|
||||
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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -163,7 +163,7 @@ module amg_s_mumps_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_mumps_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -140,7 +140,7 @@ module amg_s_poly_smoother
|
||||
import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -311,7 +311,7 @@ module amg_s_prec_type
|
||||
& psb_s_base_sparse_mat, psb_s_base_vect_type, &
|
||||
& psb_i_base_vect_type, amg_sprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_sprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -323,15 +323,14 @@ module amg_s_prec_type
|
||||
end interface amg_precbld
|
||||
|
||||
interface amg_hierarchy_bld
|
||||
subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
|
||||
& amg_sprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_sprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: cpymat
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine amg_s_hierarchy_bld
|
||||
end interface amg_hierarchy_bld
|
||||
@@ -636,11 +635,6 @@ contains
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
call prec%precv(i)%free(info)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
end do
|
||||
deallocate(prec%precv,stat=info)
|
||||
end if
|
||||
@@ -1008,7 +1002,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
!
|
||||
! In AMG the DESC optional argument is ignored, since
|
||||
! In MLD the DESC optional argument is ignored, since
|
||||
! the necessary info is contained in the various entries of the
|
||||
! PRECV component.
|
||||
type(psb_desc_type), intent(in), optional :: desc
|
||||
|
||||
@@ -124,7 +124,7 @@ module amg_s_slu_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -103,7 +103,7 @@ module amg_z_ainv_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -225,7 +225,7 @@ module amg_z_ainv_solver
|
||||
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_z_base_vect_type, psb_dpk_, psb_ipk_
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
integer(psb_ipk_), intent(in) :: fillin,alg
|
||||
real(psb_dpk_), intent(in) :: thresh
|
||||
type(psb_zspmat_type), intent(inout) :: wmat, zmat
|
||||
|
||||
@@ -230,7 +230,7 @@ module amg_z_as_smoother
|
||||
& psb_desc_type, psb_z_base_sparse_mat, psb_ipk_,&
|
||||
& psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_as_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -237,7 +237,7 @@ module amg_z_base_smoother_mod
|
||||
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
|
||||
& amg_z_base_smoother_type, psb_ipk_, psb_i_base_vect_type
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_base_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -170,7 +170,7 @@ module amg_z_base_solver_mod
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_base_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -119,7 +119,7 @@ module amg_z_diag_solver
|
||||
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_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -331,7 +331,7 @@ module amg_z_l1_diag_solver
|
||||
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_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_l1_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -181,7 +181,7 @@ module amg_z_gs_solver
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_gs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -195,7 +195,7 @@ module amg_z_gs_solver
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_bwgs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -123,7 +123,7 @@ contains
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -144,7 +144,7 @@ module amg_z_ilu_solver
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_ilu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -56,7 +56,7 @@ module amg_z_inner_mod
|
||||
& psb_dpk_, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
|
||||
import :: amg_zprec_type
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(amg_zprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -94,7 +94,7 @@ module amg_z_invk_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_invk_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -94,7 +94,7 @@ module amg_z_invt_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -151,7 +151,7 @@ module amg_z_jac_smoother
|
||||
import :: psb_desc_type, amg_z_jac_smoother_type, psb_z_vect_type, psb_dpk_, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -274,7 +274,7 @@ module amg_z_jac_smoother
|
||||
import :: psb_desc_type, amg_z_l1_jac_smoother_type, psb_z_vect_type, &
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_l1_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -143,7 +143,7 @@ module amg_z_jac_solver
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -160,7 +160,7 @@ module amg_z_jac_solver
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_l1_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -174,7 +174,7 @@ module amg_z_krm_solver
|
||||
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -163,7 +163,7 @@ module amg_z_mumps_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_mumps_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -311,7 +311,7 @@ module amg_z_prec_type
|
||||
& psb_z_base_sparse_mat, psb_z_base_vect_type, &
|
||||
& psb_i_base_vect_type, amg_zprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_zprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -323,15 +323,14 @@ module amg_z_prec_type
|
||||
end interface amg_precbld
|
||||
|
||||
interface amg_hierarchy_bld
|
||||
subroutine amg_z_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
|
||||
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& amg_zprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_zprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: cpymat
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine amg_z_hierarchy_bld
|
||||
end interface amg_hierarchy_bld
|
||||
@@ -636,11 +635,6 @@ contains
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
call prec%precv(i)%free(info)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
end do
|
||||
deallocate(prec%precv,stat=info)
|
||||
end if
|
||||
@@ -1008,7 +1002,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
!
|
||||
! In AMG the DESC optional argument is ignored, since
|
||||
! In MLD the DESC optional argument is ignored, since
|
||||
! the necessary info is contained in the various entries of the
|
||||
! PRECV component.
|
||||
type(psb_desc_type), intent(in), optional :: desc
|
||||
|
||||
@@ -124,7 +124,7 @@ module amg_z_slu_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -259,7 +259,7 @@ contains
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
|
||||
@@ -163,7 +163,7 @@ module amg_z_umf_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -155,7 +155,7 @@ subroutine amg_caggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
|
||||
debug_level = psb_get_debug_level()
|
||||
|
||||
ctxt = desc_a%get_context()
|
||||
icomm = ctxt%get_mpic()
|
||||
icomm = desc_a%get_mpic()
|
||||
|
||||
call psb_info(ctxt, me, np)
|
||||
|
||||
|
||||
@@ -155,7 +155,7 @@ subroutine amg_daggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
|
||||
debug_level = psb_get_debug_level()
|
||||
|
||||
ctxt = desc_a%get_context()
|
||||
icomm = ctxt%get_mpic()
|
||||
icomm = desc_a%get_mpic()
|
||||
|
||||
call psb_info(ctxt, me, np)
|
||||
|
||||
|
||||
@@ -155,7 +155,7 @@ subroutine amg_saggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
|
||||
debug_level = psb_get_debug_level()
|
||||
|
||||
ctxt = desc_a%get_context()
|
||||
icomm = ctxt%get_mpic()
|
||||
icomm = desc_a%get_mpic()
|
||||
|
||||
call psb_info(ctxt, me, np)
|
||||
|
||||
|
||||
@@ -155,7 +155,7 @@ subroutine amg_zaggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
|
||||
debug_level = psb_get_debug_level()
|
||||
|
||||
ctxt = desc_a%get_context()
|
||||
icomm = ctxt%get_mpic()
|
||||
icomm = desc_a%get_mpic()
|
||||
|
||||
call psb_info(ctxt, me, np)
|
||||
|
||||
|
||||
@@ -63,7 +63,7 @@
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
!
|
||||
subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
|
||||
|
||||
use psb_base_mod
|
||||
use amg_c_inner_mod
|
||||
@@ -72,11 +72,10 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_cprec_type),intent(inout),target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: cpymat
|
||||
|
||||
! Local Variables
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
@@ -91,11 +90,9 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
type(amg_sml_parms) :: medparms, coarseparms
|
||||
integer(psb_lpk_), allocatable :: ilaggr(:), nlaggr(:)
|
||||
type(psb_lcspmat_type) :: op_prol
|
||||
type(amg_c_onelev_type), allocatable :: tprecv(:)
|
||||
logical :: cpymat_
|
||||
type(amg_c_onelev_type), allocatable :: tprecv(:)
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
character(len=40) :: ch_err
|
||||
character(len=20) :: name, ch_err
|
||||
integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
@@ -128,9 +125,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
cpymat_ = .false.
|
||||
if (present(cpymat)) cpymat_ = cpymat
|
||||
|
||||
|
||||
!
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
@@ -185,15 +180,8 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
! This is OK, since it may be called by the user even if there
|
||||
! is only one level
|
||||
!
|
||||
if (cpymat_) then
|
||||
call a%clone(prec%precv(1)%ac,info)
|
||||
call desc_a%clone(prec%precv(1)%desc_ac,info)
|
||||
prec%precv(1)%base_a => prec%precv(1)%ac
|
||||
prec%precv(1)%base_desc => prec%precv(1)%desc_ac
|
||||
else
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
end if
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -292,16 +280,10 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
!
|
||||
! Finest level first; create a GEN_BLOCK
|
||||
! copy of the descriptor.
|
||||
!
|
||||
if (cpymat_) then
|
||||
call a%clone(prec%precv(1)%ac,info)
|
||||
prec%precv(1)%base_a => prec%precv(1)%ac
|
||||
else
|
||||
prec%precv(1)%base_a => a
|
||||
end if
|
||||
!
|
||||
prec%precv(1)%base_a => a
|
||||
call psb_cd_renum_block(desc_a,prec%precv(1)%desc_ac,info)
|
||||
prec%precv(1)%base_desc => prec%precv(1)%desc_ac
|
||||
|
||||
newsz = 0
|
||||
array_build_loop: do i=2, iszv
|
||||
!
|
||||
@@ -334,10 +316,9 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
& prec%precv(i-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,prec%ag_data,info)
|
||||
if (do_timings) call psb_toc(idx_bldtp)
|
||||
if (info /= psb_success_) then
|
||||
write(ch_err,'(a,i7)') 'Map bld fail @ level ',i
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err=ch_err)
|
||||
& a_err='Map build')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
@@ -366,10 +347,14 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
|
||||
if (i>2) then
|
||||
if (sizeratio < mnaggratio) then
|
||||
!
|
||||
! We are not gaining
|
||||
!
|
||||
newsz = i-1
|
||||
if (sizeratio > 1) then
|
||||
newsz = i
|
||||
else
|
||||
!
|
||||
! We are not gaining
|
||||
!
|
||||
newsz = i-1
|
||||
end if
|
||||
end if
|
||||
|
||||
if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then
|
||||
@@ -404,7 +389,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
& coarse_sm,coarse_sm2,info)
|
||||
if (newsz < i) then
|
||||
!
|
||||
! We are going back and revisit a previous level;
|
||||
! We are going back and revisit a previous leve;
|
||||
! recover the aggregation.
|
||||
!
|
||||
ilaggr = prec%precv(newsz)%linmap%iaggr
|
||||
@@ -417,9 +402,8 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
if (do_timings) call psb_toc(idx_matasb)
|
||||
if (info /= 0) then
|
||||
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',newsz
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err=ch_err)
|
||||
& a_err='Mat asb')
|
||||
goto 9999
|
||||
endif
|
||||
exit array_build_loop
|
||||
@@ -431,9 +415,8 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
if (do_timings) call psb_toc(idx_matasb)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',i
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err=ch_err)
|
||||
& a_err='Map build')
|
||||
goto 9999
|
||||
endif
|
||||
if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info)
|
||||
@@ -465,9 +448,6 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
iszv = newsz
|
||||
! Fix the pointers, but the level 1 should
|
||||
! be treated differently
|
||||
if (.not.associated(prec%precv(1)%base_a,a)) then
|
||||
prec%precv(1)%base_a => prec%precv(1)%ac
|
||||
end if
|
||||
if (.not.associated(prec%precv(1)%base_desc,desc_a)) then
|
||||
prec%precv(1)%base_desc => prec%precv(1)%desc_ac
|
||||
end if
|
||||
|
||||
@@ -101,8 +101,7 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
real(psb_spk_) :: mnaggratio
|
||||
integer(psb_ipk_) :: coarse_solve_id
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
character(len=40) :: ch_err
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
info=psb_success_
|
||||
err=0
|
||||
@@ -297,7 +296,7 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
write(ch_err,'(a,i7)') 'Error @ level ',i
|
||||
write(ch_err,'(a,i7)') 'Error @ level',i
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err=ch_err)
|
||||
goto 9999
|
||||
|
||||
@@ -88,7 +88,6 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix)
|
||||
logical :: is_symgs
|
||||
character(len=20), parameter :: name='amg_file_prec_descr'
|
||||
integer(psb_ipk_) :: iout_, root_, verbosity_
|
||||
integer(psb_lpk_) :: gl_nrows,gl_ncols,gl_nzeros
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
@@ -123,12 +122,6 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix)
|
||||
if (root_ == -1) root_ = me
|
||||
|
||||
if (verbosity_ >=0) then
|
||||
gl_nrows = prec%precv(1)%base_a%get_nrows()
|
||||
gl_ncols = prec%precv(1)%base_a%get_ncols()
|
||||
gl_nzeros = prec%precv(1)%base_a%get_nzeros()
|
||||
call psb_sum(ctxt,gl_nrows)
|
||||
call psb_sum(ctxt,gl_ncols)
|
||||
call psb_sum(ctxt,gl_nzeros)
|
||||
!
|
||||
! The preconditioner description is printed by processor psb_root_.
|
||||
! This agrees with the fact that all the parameters defining the
|
||||
@@ -148,11 +141,7 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix)
|
||||
|
||||
write(iout_,*)
|
||||
write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description'
|
||||
write(iout_,*)
|
||||
write(iout_,*) trim(prefix_),' Base matrix : ',&
|
||||
& gl_nrows, gl_ncols, gl_nzeros
|
||||
write(iout_,*)
|
||||
|
||||
|
||||
if (nlev == 1) then
|
||||
!
|
||||
! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel.
|
||||
|
||||
@@ -85,7 +85,7 @@ subroutine amg_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_cspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(amg_cprec_type),intent(inout),target :: p
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -65,7 +65,7 @@ subroutine amg_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type),intent(inout), target :: a
|
||||
type(psb_cspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_cprec_type),intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -63,7 +63,7 @@
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
!
|
||||
subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
|
||||
|
||||
use psb_base_mod
|
||||
use amg_d_inner_mod
|
||||
@@ -72,11 +72,10 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_dprec_type),intent(inout),target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: cpymat
|
||||
|
||||
! Local Variables
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
@@ -91,11 +90,9 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
type(amg_dml_parms) :: medparms, coarseparms
|
||||
integer(psb_lpk_), allocatable :: ilaggr(:), nlaggr(:)
|
||||
type(psb_ldspmat_type) :: op_prol
|
||||
type(amg_d_onelev_type), allocatable :: tprecv(:)
|
||||
logical :: cpymat_
|
||||
type(amg_d_onelev_type), allocatable :: tprecv(:)
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
character(len=40) :: ch_err
|
||||
character(len=20) :: name, ch_err
|
||||
integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
@@ -128,9 +125,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
cpymat_ = .false.
|
||||
if (present(cpymat)) cpymat_ = cpymat
|
||||
|
||||
|
||||
!
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
@@ -185,15 +180,8 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
! This is OK, since it may be called by the user even if there
|
||||
! is only one level
|
||||
!
|
||||
if (cpymat_) then
|
||||
call a%clone(prec%precv(1)%ac,info)
|
||||
call desc_a%clone(prec%precv(1)%desc_ac,info)
|
||||
prec%precv(1)%base_a => prec%precv(1)%ac
|
||||
prec%precv(1)%base_desc => prec%precv(1)%desc_ac
|
||||
else
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
end if
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -292,16 +280,10 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
!
|
||||
! Finest level first; create a GEN_BLOCK
|
||||
! copy of the descriptor.
|
||||
!
|
||||
if (cpymat_) then
|
||||
call a%clone(prec%precv(1)%ac,info)
|
||||
prec%precv(1)%base_a => prec%precv(1)%ac
|
||||
else
|
||||
prec%precv(1)%base_a => a
|
||||
end if
|
||||
!
|
||||
prec%precv(1)%base_a => a
|
||||
call psb_cd_renum_block(desc_a,prec%precv(1)%desc_ac,info)
|
||||
prec%precv(1)%base_desc => prec%precv(1)%desc_ac
|
||||
|
||||
newsz = 0
|
||||
array_build_loop: do i=2, iszv
|
||||
!
|
||||
@@ -334,10 +316,9 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
& prec%precv(i-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,prec%ag_data,info)
|
||||
if (do_timings) call psb_toc(idx_bldtp)
|
||||
if (info /= psb_success_) then
|
||||
write(ch_err,'(a,i7)') 'Map bld fail @ level ',i
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err=ch_err)
|
||||
& a_err='Map build')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
@@ -366,10 +347,14 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
|
||||
if (i>2) then
|
||||
if (sizeratio < mnaggratio) then
|
||||
!
|
||||
! We are not gaining
|
||||
!
|
||||
newsz = i-1
|
||||
if (sizeratio > 1) then
|
||||
newsz = i
|
||||
else
|
||||
!
|
||||
! We are not gaining
|
||||
!
|
||||
newsz = i-1
|
||||
end if
|
||||
end if
|
||||
|
||||
if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then
|
||||
@@ -404,7 +389,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
& coarse_sm,coarse_sm2,info)
|
||||
if (newsz < i) then
|
||||
!
|
||||
! We are going back and revisit a previous level;
|
||||
! We are going back and revisit a previous leve;
|
||||
! recover the aggregation.
|
||||
!
|
||||
ilaggr = prec%precv(newsz)%linmap%iaggr
|
||||
@@ -417,9 +402,8 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
if (do_timings) call psb_toc(idx_matasb)
|
||||
if (info /= 0) then
|
||||
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',newsz
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err=ch_err)
|
||||
& a_err='Mat asb')
|
||||
goto 9999
|
||||
endif
|
||||
exit array_build_loop
|
||||
@@ -431,9 +415,8 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
if (do_timings) call psb_toc(idx_matasb)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',i
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err=ch_err)
|
||||
& a_err='Map build')
|
||||
goto 9999
|
||||
endif
|
||||
if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info)
|
||||
@@ -465,9 +448,6 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
iszv = newsz
|
||||
! Fix the pointers, but the level 1 should
|
||||
! be treated differently
|
||||
if (.not.associated(prec%precv(1)%base_a,a)) then
|
||||
prec%precv(1)%base_a => prec%precv(1)%ac
|
||||
end if
|
||||
if (.not.associated(prec%precv(1)%base_desc,desc_a)) then
|
||||
prec%precv(1)%base_desc => prec%precv(1)%desc_ac
|
||||
end if
|
||||
|
||||
@@ -101,8 +101,7 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
real(psb_dpk_) :: mnaggratio
|
||||
integer(psb_ipk_) :: coarse_solve_id
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
character(len=40) :: ch_err
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
info=psb_success_
|
||||
err=0
|
||||
@@ -297,7 +296,7 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
write(ch_err,'(a,i7)') 'Error @ level ',i
|
||||
write(ch_err,'(a,i7)') 'Error @ level',i
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err=ch_err)
|
||||
goto 9999
|
||||
|
||||
@@ -88,7 +88,6 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix)
|
||||
logical :: is_symgs
|
||||
character(len=20), parameter :: name='amg_file_prec_descr'
|
||||
integer(psb_ipk_) :: iout_, root_, verbosity_
|
||||
integer(psb_lpk_) :: gl_nrows,gl_ncols,gl_nzeros
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
@@ -123,12 +122,6 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix)
|
||||
if (root_ == -1) root_ = me
|
||||
|
||||
if (verbosity_ >=0) then
|
||||
gl_nrows = prec%precv(1)%base_a%get_nrows()
|
||||
gl_ncols = prec%precv(1)%base_a%get_ncols()
|
||||
gl_nzeros = prec%precv(1)%base_a%get_nzeros()
|
||||
call psb_sum(ctxt,gl_nrows)
|
||||
call psb_sum(ctxt,gl_ncols)
|
||||
call psb_sum(ctxt,gl_nzeros)
|
||||
!
|
||||
! The preconditioner description is printed by processor psb_root_.
|
||||
! This agrees with the fact that all the parameters defining the
|
||||
@@ -148,11 +141,7 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix)
|
||||
|
||||
write(iout_,*)
|
||||
write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description'
|
||||
write(iout_,*)
|
||||
write(iout_,*) trim(prefix_),' Base matrix : ',&
|
||||
& gl_nrows, gl_ncols, gl_nzeros
|
||||
write(iout_,*)
|
||||
|
||||
|
||||
if (nlev == 1) then
|
||||
!
|
||||
! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel.
|
||||
|
||||
@@ -85,7 +85,7 @@ subroutine amg_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_dspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(amg_dprec_type),intent(inout),target :: p
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -65,7 +65,7 @@ subroutine amg_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type),intent(inout), target :: a
|
||||
type(psb_dspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_dprec_type),intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -63,7 +63,7 @@
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
!
|
||||
subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
|
||||
|
||||
use psb_base_mod
|
||||
use amg_s_inner_mod
|
||||
@@ -72,11 +72,10 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_sspmat_type),intent(in), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_sprec_type),intent(inout),target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: cpymat
|
||||
|
||||
! Local Variables
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
@@ -91,11 +90,9 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
type(amg_sml_parms) :: medparms, coarseparms
|
||||
integer(psb_lpk_), allocatable :: ilaggr(:), nlaggr(:)
|
||||
type(psb_lsspmat_type) :: op_prol
|
||||
type(amg_s_onelev_type), allocatable :: tprecv(:)
|
||||
logical :: cpymat_
|
||||
type(amg_s_onelev_type), allocatable :: tprecv(:)
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
character(len=40) :: ch_err
|
||||
character(len=20) :: name, ch_err
|
||||
integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
@@ -128,9 +125,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
cpymat_ = .false.
|
||||
if (present(cpymat)) cpymat_ = cpymat
|
||||
|
||||
|
||||
!
|
||||
! Check to ensure all procs have the same
|
||||
!
|
||||
@@ -185,15 +180,8 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
! This is OK, since it may be called by the user even if there
|
||||
! is only one level
|
||||
!
|
||||
if (cpymat_) then
|
||||
call a%clone(prec%precv(1)%ac,info)
|
||||
call desc_a%clone(prec%precv(1)%desc_ac,info)
|
||||
prec%precv(1)%base_a => prec%precv(1)%ac
|
||||
prec%precv(1)%base_desc => prec%precv(1)%desc_ac
|
||||
else
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
end if
|
||||
prec%precv(1)%base_a => a
|
||||
prec%precv(1)%base_desc => desc_a
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -292,16 +280,10 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
!
|
||||
! Finest level first; create a GEN_BLOCK
|
||||
! copy of the descriptor.
|
||||
!
|
||||
if (cpymat_) then
|
||||
call a%clone(prec%precv(1)%ac,info)
|
||||
prec%precv(1)%base_a => prec%precv(1)%ac
|
||||
else
|
||||
prec%precv(1)%base_a => a
|
||||
end if
|
||||
!
|
||||
prec%precv(1)%base_a => a
|
||||
call psb_cd_renum_block(desc_a,prec%precv(1)%desc_ac,info)
|
||||
prec%precv(1)%base_desc => prec%precv(1)%desc_ac
|
||||
|
||||
newsz = 0
|
||||
array_build_loop: do i=2, iszv
|
||||
!
|
||||
@@ -334,10 +316,9 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
& prec%precv(i-1)%base_desc,&
|
||||
& ilaggr,nlaggr,op_prol,prec%ag_data,info)
|
||||
if (do_timings) call psb_toc(idx_bldtp)
|
||||
if (info /= psb_success_) then
|
||||
write(ch_err,'(a,i7)') 'Map bld fail @ level ',i
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err=ch_err)
|
||||
& a_err='Map build')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
@@ -366,10 +347,14 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
|
||||
if (i>2) then
|
||||
if (sizeratio < mnaggratio) then
|
||||
!
|
||||
! We are not gaining
|
||||
!
|
||||
newsz = i-1
|
||||
if (sizeratio > 1) then
|
||||
newsz = i
|
||||
else
|
||||
!
|
||||
! We are not gaining
|
||||
!
|
||||
newsz = i-1
|
||||
end if
|
||||
end if
|
||||
|
||||
if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then
|
||||
@@ -404,7 +389,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
& coarse_sm,coarse_sm2,info)
|
||||
if (newsz < i) then
|
||||
!
|
||||
! We are going back and revisit a previous level;
|
||||
! We are going back and revisit a previous leve;
|
||||
! recover the aggregation.
|
||||
!
|
||||
ilaggr = prec%precv(newsz)%linmap%iaggr
|
||||
@@ -417,9 +402,8 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
& ilaggr,nlaggr,op_prol,info)
|
||||
if (do_timings) call psb_toc(idx_matasb)
|
||||
if (info /= 0) then
|
||||
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',newsz
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err=ch_err)
|
||||
& a_err='Mat asb')
|
||||
goto 9999
|
||||
endif
|
||||
exit array_build_loop
|
||||
@@ -431,9 +415,8 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
if (do_timings) call psb_toc(idx_matasb)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',i
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err=ch_err)
|
||||
& a_err='Map build')
|
||||
goto 9999
|
||||
endif
|
||||
if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info)
|
||||
@@ -465,9 +448,6 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
iszv = newsz
|
||||
! Fix the pointers, but the level 1 should
|
||||
! be treated differently
|
||||
if (.not.associated(prec%precv(1)%base_a,a)) then
|
||||
prec%precv(1)%base_a => prec%precv(1)%ac
|
||||
end if
|
||||
if (.not.associated(prec%precv(1)%base_desc,desc_a)) then
|
||||
prec%precv(1)%base_desc => prec%precv(1)%desc_ac
|
||||
end if
|
||||
|
||||
@@ -101,8 +101,7 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
real(psb_spk_) :: mnaggratio
|
||||
integer(psb_ipk_) :: coarse_solve_id
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
character(len=40) :: ch_err
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
info=psb_success_
|
||||
err=0
|
||||
@@ -297,7 +296,7 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
write(ch_err,'(a,i7)') 'Error @ level ',i
|
||||
write(ch_err,'(a,i7)') 'Error @ level',i
|
||||
call psb_errpush(psb_err_internal_error_,name,&
|
||||
& a_err=ch_err)
|
||||
goto 9999
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user