mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-07 07:04:59 +00:00
Compare commits
5
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
5005c1a4ba | ||
|
|
150724341f | ||
|
|
525f971978 | ||
|
|
c6daa45aa8 | ||
|
|
6c0a8831d8 |
@@ -1,5 +1,6 @@
|
||||
$Format:%d%n%n$
|
||||
1.2.1
|
||||
# Fall back version, probably last release:
|
||||
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
|
||||
|
||||
+3
-4
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -1012,7 +1006,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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -1012,7 +1006,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
|
||||
|
||||
@@ -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
|
||||
@@ -1012,7 +1006,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
|
||||
@@ -1012,7 +1006,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
|
||||
|
||||
@@ -88,7 +88,6 @@ subroutine amg_sfile_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_sfile_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_sfile_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_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
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
|
||||
type(amg_sprec_type),intent(inout),target :: p
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -65,7 +65,7 @@ subroutine amg_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
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
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user