mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-10 07:59:06 +00:00
Compare commits
1
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
 Cirdans-Home
|
a2a1532b90 |
@@ -1,12 +0,0 @@
|
||||
$Format:%d%n%n$
|
||||
# Fall back version, probably last release:
|
||||
1.2.1
|
||||
|
||||
# AMG4PSBLAS version file.
|
||||
#
|
||||
# Release archive created from commit:
|
||||
# $Format:%H %d$
|
||||
# $Format:Created on %ci by %cN, and$
|
||||
# $Format:signed by %GS using %GK.$
|
||||
# $Format:Signature status: %G?$
|
||||
$Format:%GG$
|
||||
@@ -1,28 +0,0 @@
|
||||
*.a export-ignore
|
||||
*.o export-ignore
|
||||
*.mod export-ignore
|
||||
*.smod export-ignore
|
||||
*~ export-ignore
|
||||
.git* export-ignore
|
||||
|
||||
Make.inc export-ignore
|
||||
config export-ignore
|
||||
config/ export-ignore
|
||||
config/** export-ignore
|
||||
configure.ac export-ignore
|
||||
config.log export-ignore
|
||||
config.status export-ignore
|
||||
aclocal.m4 export-ignore
|
||||
autogen.sh export-ignore
|
||||
autom4te.cache export-ignore
|
||||
Dockerfile export-ignore
|
||||
.travis.yml export-ignore
|
||||
# generated folder
|
||||
./include/** export-ignore
|
||||
./modules/** export-ignore
|
||||
docs/src export-ignore
|
||||
docs/doxypsb export-ignore
|
||||
docs/Makefile export-ignore
|
||||
|
||||
# the executable from tests
|
||||
|
||||
+3
-6
@@ -5,7 +5,6 @@
|
||||
|
||||
# header files generated
|
||||
cbind/*.h
|
||||
amgprec/amg_config.h
|
||||
|
||||
# Make.inc generated
|
||||
/Make.inc
|
||||
@@ -13,13 +12,11 @@ config.log
|
||||
config.status
|
||||
|
||||
# generated folder
|
||||
/include/
|
||||
/modules/
|
||||
/docs/src/tmp
|
||||
include/
|
||||
modules/
|
||||
docs/src/tmp
|
||||
autom4te.cache
|
||||
|
||||
# the executable from tests
|
||||
runs
|
||||
|
||||
# Documentation temporary files
|
||||
docs/src/userguide.pdf
|
||||
|
||||
-546
@@ -1,546 +0,0 @@
|
||||
cmake_minimum_required(VERSION 3.10)
|
||||
project(amg4psblas VERSION 1.0 LANGUAGES C CXX Fortran)
|
||||
|
||||
|
||||
set(CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/cmake")
|
||||
|
||||
|
||||
set(PSBLAS_INSTALL_DIR "" CACHE PATH "Path to the PSBLAS installation
|
||||
directory")
|
||||
if(PSBLAS_INSTALL_DIR STREQUAL "")
|
||||
message(FATAL_ERROR "Please specify the path to the PSBLAS installation directory using -DPSBLAS_INSTALL_DIR=<path> or set it in ccmake.")
|
||||
endif()
|
||||
|
||||
|
||||
# Check for the installation path for psblas
|
||||
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
|
||||
|
||||
|
||||
# Find the psblas package
|
||||
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}")
|
||||
endif()
|
||||
|
||||
if(CMAKE_BUILD_TYPE STREQUAL "Debug")
|
||||
# Add -g to the Fortran compiler flags.
|
||||
# We use STRING(APPEND) to ensure we don't overwrite other important flags.
|
||||
string(APPEND CMAKE_Fortran_FLAGS " -g")
|
||||
string(APPEND CMAKE_CXX_FLAGS " -g")
|
||||
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")
|
||||
|
||||
|
||||
|
||||
# Set the include and library directories based on the provided path
|
||||
#set(TEST_INSTALLDIR "${PSBLAS_INSTALL_DIR}")
|
||||
set(INCDIR "${PSBLAS_INSTALL_DIR}/${PSB_CMAKE_INSTALL_INCLUDEDIR}")
|
||||
set(MODDIR "${PSBLAS_INSTALL_DIR}/${PSB_CMAKE_INSTALL_MODULDIR}")
|
||||
set(LIBDIR "${PSBLAS_INSTALL_DIR}/${PSB_CMAKE_INSTALL_LIBDIR}")
|
||||
|
||||
|
||||
# Include directories for the project
|
||||
include_directories(${PSBLAS_INSTALL_DIR} ${MPI_INCLUDE_PATH} )
|
||||
|
||||
|
||||
# Include directories for the Fortran compiler
|
||||
include_directories(${INCDIR} ${MODDIR} ${LIBDIR})
|
||||
|
||||
|
||||
|
||||
message(STATUS "Using IPK size: ${PSB_IPK_SIZE}")
|
||||
message(STATUS "Using LPK size: ${PSB_LPK_SIZE}")
|
||||
|
||||
# Add PSB_IPK/LPK flag only for fortran files.
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_IPK${PSB_IPK_SIZE}")
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_LPK${PSB_LPK_SIZE}")
|
||||
|
||||
|
||||
|
||||
|
||||
# Specify the installation directory
|
||||
|
||||
#set(${CMAKE_INSTALL_LIBDIR} "lib")
|
||||
#message(STATUS "\t\t install libdir ${CMAKE_INSTALL_LIBDIR};")
|
||||
#set(CMAKE_RUNTIME_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_BINDIR}/${${CMAKE_PROJECT_NAME}_dist_string}-tests")
|
||||
#set(CMAKE_LIBRARY_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_LIBDIR}")
|
||||
#set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_LIBDIR}")
|
||||
|
||||
|
||||
set(CMAKE_RUNTIME_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_BINDIR}/${${CMAKE_PROJECT_NAME}_dist_string}-tests")
|
||||
set(CMAKE_LIBRARY_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}")
|
||||
set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}")
|
||||
#set(CMAKE_INSTALL_LIBDIR "lib" CACHE STRING "Library install directory")
|
||||
#set(CMAKE_INSTALL_INCLUDEDIR "include" CACHE STRING "Include directory")
|
||||
#set(CMAKE_INSTALL_MODULDIR "modules" CACHE STRING "Module directory")
|
||||
|
||||
message(STATUS "Initial CMAKE_INSTALL_LIBDIR: ${CMAKE_INSTALL_LIBDIR}")
|
||||
set(AMG_CMAKE_INSTALL_PREFIX ${CMAKE_INSTALL_PREFIX})
|
||||
|
||||
if(NOT AMG_CMAKE_INSTALL_LIBDIR)
|
||||
message(STATUS "CMAKE_INSTALL_LIBDIR is set to default value lib")
|
||||
#set(CMAKE_INSTALL_LIBDIR "lib" CACHE STRING "Library install directory" FORCE)
|
||||
set(CMAKE_INSTALL_LIBDIR ${PSB_CMAKE_INSTALL_LIBDIR})
|
||||
set(AMG_CMAKE_INSTALL_LIBDIR ${PSB_CMAKE_INSTALL_LIBDIR})
|
||||
else()
|
||||
set(CMAKE_INSTALL_LIBDIR ${AMG_CMAKE_INSTALL_LIBDIR})
|
||||
message(STATUS "CMAKE_INSTALL_LIBDIR is set to: ${CMAKE_INSTALL_LIBDIR}")
|
||||
endif()
|
||||
|
||||
if(NOT AMG_CMAKE_INSTALL_INCLUDEDIR)
|
||||
message(STATUS "CMAKE_INSTALL_INCLUDEDIR is set to default value lib")
|
||||
#set(CMAKE_INSTALL_INCLUDEDIR "include" CACHE STRING "Include directory" FORCE)
|
||||
set(CMAKE_INSTALL_INCLUDEDIR ${PSB_CMAKE_INSTALL_INCLUDEDIR})
|
||||
set(AMG_CMAKE_INSTALL_INCLUDEDIR ${PSB_CMAKE_INSTALL_INCLUDEDIR})
|
||||
else()
|
||||
set(CMAKE_INSTALL_INCLUDEDIR ${AMG_CMAKE_INSTALL_INCLUDEDIR})
|
||||
message(STATUS "CMAKE_INSTALL_INCLUDEDIR is set to: ${CMAKE_INSTALL_INCLUDEDIR}")
|
||||
endif()
|
||||
|
||||
if(NOT AMG_CMAKE_INSTALL_MODULDIR)
|
||||
message(STATUS "CMAKE_INSTALL_MODULDIR is set to default value lib")
|
||||
#set(CMAKE_INSTALL_MODULDIR "modules" CACHE STRING "Modules directory" FORCE)
|
||||
set(CMAKE_INSTALL_MODULDIR ${PSB_CMAKE_INSTALL_MODULDIR})
|
||||
set(AMG_CMAKE_INSTALL_LIBDIR ${PSB_CMAKE_INSTALL_MODULDIR})
|
||||
else()
|
||||
set(CMAKE_INSTALL_MODULDIR ${AMG_CMAKE_INSTALL_MODULDIR})
|
||||
message(STATUS "CMAKE_INSTALL_MODULDIR is set to: ${CMAKE_INSTALL_MODULDIR}")
|
||||
endif()
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#-----------------------------------------------------
|
||||
# Publicize installed location to other CMake projects
|
||||
#-----------------------------------------------------
|
||||
#install(EXPORT ${CMAKE_PROJECT_NAME}-targets
|
||||
# DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake"
|
||||
#)
|
||||
|
||||
|
||||
message(STATUS "NAME project ${CMAKE_PROJECT_NAME};")
|
||||
|
||||
install(EXPORT ${CMAKE_PROJECT_NAME}-targets
|
||||
FILE ${CMAKE_PROJECT_NAME}Config.cmake
|
||||
NAMESPACE ${CMAKE_PROJECT_NAME}::
|
||||
DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake"
|
||||
)
|
||||
|
||||
|
||||
include(CMakePackageConfigHelpers) # standard CMake module
|
||||
write_basic_package_version_file(
|
||||
"${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_PROJECT_NAME}ConfigVersion.cmake"
|
||||
VERSION "${amg4psblas_VERSION}"
|
||||
COMPATIBILITY SameMajorVersion
|
||||
)
|
||||
|
||||
configure_file("${CMAKE_SOURCE_DIR}/cmake/${CMAKE_PROJECT_NAME}Config.cmake.in"
|
||||
"${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/${CMAKE_PROJECT_NAME}Config.cmake" @ONLY)
|
||||
|
||||
install(
|
||||
FILES
|
||||
"${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/${CMAKE_PROJECT_NAME}Config.cmake"
|
||||
"${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_PROJECT_NAME}ConfigVersion.cmake"
|
||||
"${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_PROJECT_NAME}Targets.cmake"
|
||||
DESTINATION
|
||||
"${CMAKE_INSTALL_LIBDIR}/cmake/${CMAKE_PROJECT_NAME}"
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#------------------------------------------
|
||||
# Add portable unistall command to makefile
|
||||
#------------------------------------------
|
||||
# Adapted from the CMake Wiki FAQ
|
||||
configure_file ( "${CMAKE_SOURCE_DIR}/cmake/uninstall.cmake.in" "${CMAKE_BINARY_DIR}/uninstall.cmake"
|
||||
@ONLY)
|
||||
|
||||
add_custom_target ( uninstall
|
||||
COMMAND ${CMAKE_COMMAND} -P "${CMAKE_BINARY_DIR}/uninstall.cmake" )
|
||||
|
||||
add_custom_target(check COMMAND ${CMAKE_CTEST_COMMAND} --output-on-failure)
|
||||
# See JSON-Fortran's CMakeLists.txt file to find out how to get the check target to depend
|
||||
# on the test executables
|
||||
|
||||
#----------------------------------
|
||||
# Determine if we're using Open MPI
|
||||
#---------------------------------
|
||||
|
||||
|
||||
|
||||
find_package( MPI REQUIRED Fortran C CXX )
|
||||
|
||||
if(MPI_FOUND)
|
||||
#-----------------------------------------------
|
||||
# Work around an issue present on fedora systems
|
||||
#-----------------------------------------------
|
||||
if( (MPI_CXX_LINK_FLAGS MATCHES "noexecstack") OR (MPI_Fortran_LINK_FLAGS MATCHES "noexecstack") )
|
||||
message ( WARNING
|
||||
"The `noexecstack` linker flag was found in the MPI_<lang>_LINK_FLAGS variable. This is
|
||||
known to cause segmentation faults for some Fortran codes. See, e.g.,
|
||||
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=71729 or
|
||||
https://github.com/sourceryinstitute/OpenCoarrays/issues/317.
|
||||
|
||||
`noexecstack` is being replaced with `execstack`"
|
||||
)
|
||||
string(REPLACE "noexecstack"
|
||||
"execstack" MPI_CXX_LINK_FLAGS_FIXED ${MPI_CXX_LINK_FLAGS})
|
||||
string(REPLACE "noexecstack"
|
||||
"execstack" MPI_C_LINK_FLAGS_FIXED ${MPI_C_LINK_FLAGS})
|
||||
string(REPLACE "noexecstack"
|
||||
"execstack" MPI_Fortran_LINK_FLAGS_FIXED ${MPI_Fortran_LINK_FLAGS})
|
||||
set(MPI_CXX_LINK_FLAGS "${MPI_CXX_LINK_FLAGS_FIXED}" CACHE STRING
|
||||
"MPI CXX linking flags" FORCE)
|
||||
set(MPI_C_LINK_FLAGS "${MPI_C_LINK_FLAGS_FIXED}" CACHE STRING
|
||||
"MPI C linking flags" FORCE)
|
||||
set(MPI_Fortran_LINK_FLAGS "${MPI_Fortran_LINK_FLAGS_FIXED}" CACHE STRING
|
||||
"MPI Fortran linking flags" FORCE)
|
||||
|
||||
endif()
|
||||
|
||||
message(STATUS "Found MPI: ${MPI_C_LIBRARIES} - ${MPI_CXX_LIBRARIES} - ${MPI_Fortran_LIBRARIES}")
|
||||
|
||||
|
||||
#----------------
|
||||
# Setup MPI compilers
|
||||
#----------------
|
||||
set(CMAKE_C_COMPILER ${MPI_C_COMPILER} CACHE FILEPATH "C compiler" FORCE)
|
||||
set(CMAKE_CXX_COMPILER ${MPI_CXX_COMPILER} CACHE FILEPATH "C++ compiler" FORCE)
|
||||
set(CMAKE_Fortran_COMPILER ${MPI_Fortran_COMPILER} CACHE FILEPATH "Fortran compiler" FORCE)
|
||||
|
||||
#----------------
|
||||
# Setup MPI flags
|
||||
#----------------
|
||||
list(REMOVE_DUPLICATES MPI_Fortran_INCLUDE_PATH)
|
||||
set(CMAKE_C_COMPILE_FLAGS ${CMAKE_C_COMPILE_FLAGS} ${MPI_C_COMPILE_FLAGS})
|
||||
set(CMAKE_C_LINK_FLAGS ${CMAKE_C_LINK_FLAGS} ${MPI_C_LINK_FLAGS})
|
||||
set(CMAKE_CXX_COMPILE_FLAGS ${CMAKE_CXX_COMPILE_FLAGS} ${MPI_CXX_COMPILE_FLAGS})
|
||||
set(CMAKE_CXX_LINK_FLAGS ${CMAKE_CXX_LINK_FLAGS} ${MPI_CXX_LINK_FLAGS})
|
||||
set(CMAKE_Fortran_COMPILE_FLAGS ${CMAKE_Fortran_COMPILE_FLAGS} ${MPI_Fortran_COMPILE_FLAGS})
|
||||
set(CMAKE_Fortran_LINK_FLAGS ${CMAKE_Fortran_LINK_FLAGS} ${MPI_Fortran_LINK_FLAGS})
|
||||
include_directories(BEFORE ${MPI_C_INCLUDE_PATH} ${MPI_CXX_INCLUDE_PATH} ${MPI_Fortran_INCLUDE_PATH})
|
||||
message(STATUS "${MPI_C_INCLUDE_PATH}; ${MPI_Fortran_INCLUDE_PATH};; ${CMAKE_Fortran_LINK_FLAGS} ;")
|
||||
if(MPI_Fortran_HAVE_F90_MODULE OR MPI_Fortran_HAVE_F08_MODULE)
|
||||
add_compile_options(-DPSB_MPI_MOD)
|
||||
message(STATUS "-DPSB_MPI_MOD")
|
||||
#add_compile_options(-DSERIAL_MPI) # Is it right??
|
||||
#message(STATUS "-DSERIAL_MPI")
|
||||
endif()
|
||||
set(PSB_SERIAL_MPI OFF)
|
||||
|
||||
else()
|
||||
message(STATUS "MPI not found, serial ahead")
|
||||
add_compile_options(-DPSB_SERIAL_MPI)
|
||||
add_compile_options(-DPSB_MPI_MOD)
|
||||
set(PSB_SERIAL_MPI ON)
|
||||
set(CSERIALMPI "#define PSB_SERIAL_MPI")
|
||||
endif()
|
||||
|
||||
add_compile_options(-O3)
|
||||
add_compile_options($<$<COMPILE_LANGUAGE:Fortran>:-frecursive>)
|
||||
|
||||
if(MPI_FOUND)
|
||||
execute_process(COMMAND ${MPIEXEC} --version
|
||||
OUTPUT_VARIABLE mpi_version_out)
|
||||
if (mpi_version_out MATCHES "[Oo]pen[ -][Mm][Pp][Ii]")
|
||||
message( STATUS "OpenMPI detected")
|
||||
set ( openmpi true )
|
||||
endif()
|
||||
|
||||
|
||||
set(MPI_H_COPIED FALSE)
|
||||
set(MPI_INCLUDE_DIR "${CMAKE_CURRENT_BINARY_DIR}/include") # Define the include directory
|
||||
|
||||
# Create the include directory if it doesn't exist
|
||||
file(MAKE_DIRECTORY "${MPI_INCLUDE_DIR}")
|
||||
|
||||
foreach(path IN LISTS MPI_INCLUDE_PATH)
|
||||
# Construct the full path to the mpi.h file
|
||||
set(mpi_h_path "${path}/mpi.h")
|
||||
|
||||
# Check if the mpi.h file exists
|
||||
if(EXISTS "${mpi_h_path}")
|
||||
# Copy the mpi.h file to the include directory
|
||||
file(COPY "${mpi_h_path}" DESTINATION "${MPI_INCLUDE_DIR}")
|
||||
message(STATUS "Copied mpi.h from ${mpi_h_path} to ${MPI_INCLUDE_DIR}")
|
||||
set(MPI_H_COPIED TRUE)
|
||||
break() # Exit the loop once we've copied the file
|
||||
endif()
|
||||
endforeach()
|
||||
|
||||
if(NOT MPI_H_COPIED)
|
||||
message(WARNING "mpi.h not found in any of the specified paths: ${MPI_INCLUDE_PATH}")
|
||||
endif()
|
||||
|
||||
# Add the created include directory to the project's include directories
|
||||
#include_directories("${MPI_INCLUDE_DIR}")
|
||||
endif()
|
||||
|
||||
# Find AMG constants
|
||||
include(${CMAKE_CURRENT_LIST_DIR}/cmake/readAMGConst.cmake)
|
||||
_amg_read_const()
|
||||
|
||||
if ("${PSB_LPK_SIZE}" EQUAL 8)
|
||||
set(CXXMATCHBOXBIT "#define AMG_MATCHBOXP_BIT64")
|
||||
endif()
|
||||
|
||||
|
||||
#------------------------------------------
|
||||
# Configure the amg_config.h file
|
||||
#------------------------------------------
|
||||
|
||||
message(STATUS "bin dir ${CMAKE_CURRENT_BINARY_DIR}; source dir ${CMAKE_CURRENT_SOURCE_DIR};;")
|
||||
configure_file(
|
||||
${CMAKE_CURRENT_SOURCE_DIR}/amgprec/amg_config.h.in
|
||||
${CMAKE_CURRENT_BINARY_DIR}/include/amg_config.h
|
||||
@ONLY # Replace variables only
|
||||
)
|
||||
|
||||
|
||||
|
||||
#---------------------------------------
|
||||
# Add the AMG libraries
|
||||
#---------------------------------------
|
||||
|
||||
# In your CMakeLists.txt
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-256")
|
||||
|
||||
message(STATUS "MPI_LIBRARIES: ${MPI_LIBRARIES}")
|
||||
message(STATUS "MPI_CXX_LIBRARIES: ${MPI_CXX_LIBRARIES}")
|
||||
|
||||
|
||||
|
||||
include(${CMAKE_CURRENT_LIST_DIR}/amgprec/CMakeLists.txt) # include amgprec_source_files and amgprec_source_C_files source files
|
||||
|
||||
include_directories("${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_INCLUDEDIR}")
|
||||
|
||||
add_library(amgprec_C OBJECT ${amgprec_source_C_files})
|
||||
add_library(amgprec_CPP OBJECT ${amgprec_source_CPP_files})
|
||||
|
||||
target_link_libraries(amgprec_C
|
||||
#PUBLIC ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES} ${LAPACK95_LIBRARIES}
|
||||
#PUBLIC ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES} ${BLAS95_LIBRARIES}
|
||||
psblas::util psblas::linsolve psblas::prec psblas::ext psblas::cbind psblas::base
|
||||
#${MPI_C_LIBRARIES}
|
||||
) #TODO check actual libraries needed
|
||||
|
||||
target_link_libraries(amgprec_CPP
|
||||
#PUBLIC ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES} ${LAPACK95_LIBRARIES}
|
||||
#PUBLIC ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES} ${BLAS95_LIBRARIES}
|
||||
psblas::util psblas::linsolve psblas::prec psblas::ext psblas::cbind psblas::base
|
||||
stdc++
|
||||
${MPI_CXX_LIBRARIES}) #TODO check actual libraries needed
|
||||
|
||||
add_library(amgprec ${amgprec_source_files} $<TARGET_OBJECTS:amgprec_CPP> $<TARGET_OBJECTS:amgprec_C> )
|
||||
|
||||
set_target_properties(amgprec
|
||||
PROPERTIES
|
||||
Fortran_MODULE_DIRECTORY "${CMAKE_BINARY_DIR}/modules"
|
||||
POSITION_INDEPENDENT_CODE TRUE
|
||||
OUTPUT_NAME amg_prec
|
||||
LINKER_LANGUAGE Fortran
|
||||
)
|
||||
|
||||
target_include_directories(amgprec PUBLIC
|
||||
$<BUILD_INTERFACE:${CMAKE_BINARY_DIR}/modules>
|
||||
$<INSTALL_INTERFACE:modules>)
|
||||
|
||||
message(STATUS "include dir := ${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_INCLUDEDIR}")
|
||||
|
||||
#target_include_directories(base PUBLIC ${CMAKE_Fortran_MODULE_DIRECTORY})
|
||||
|
||||
target_include_directories(amgprec PUBLIC ${INCDIR} ${MODDIR})
|
||||
target_link_libraries(amgprec
|
||||
#PUBLIC ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES} ${LAPACK95_LIBRARIES}
|
||||
#PUBLIC ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES} ${BLAS95_LIBRARIES}
|
||||
psblas::util psblas::linsolve psblas::prec psblas::ext psblas::cbind psblas::base
|
||||
#${MPI_Fortran_LIBRARIES} ${MPI_CXX_LIBRARIES} ${MPI_C_LIBRARIES}
|
||||
) #TODO check actual libraries needed
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
include(${CMAKE_CURRENT_LIST_DIR}/cbind/CMakeLists.txt) # include amgprec_source_files and amgprec_source_C_files source files
|
||||
|
||||
|
||||
foreach(path IN LISTS amgcbind_header_C_files)
|
||||
# Copy the header file to the include directory
|
||||
file(COPY "${path}" DESTINATION "${CMAKE_BINARY_DIR}/include")
|
||||
endforeach()
|
||||
|
||||
|
||||
add_library(amgcbind_C OBJECT ${amgcbind_source_C_files})
|
||||
|
||||
target_link_libraries(amgcbind_C
|
||||
#PUBLIC ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES} ${LAPACK95_LIBRARIES}
|
||||
#PUBLIC ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES} ${BLAS95_LIBRARIES}
|
||||
psblas::util psblas::linsolve psblas::prec psblas::ext psblas::cbind psblas::base) #TODO check actual libraries needed
|
||||
|
||||
add_library(amgcbind ${amgcbind_source_files} $<TARGET_OBJECTS:amgcbind_C>)
|
||||
|
||||
set_target_properties(amgcbind
|
||||
PROPERTIES
|
||||
Fortran_MODULE_DIRECTORY "${CMAKE_BINARY_DIR}/modules"
|
||||
POSITION_INDEPENDENT_CODE TRUE
|
||||
OUTPUT_NAME amg_cbind
|
||||
LINKER_LANGUAGE Fortran
|
||||
)
|
||||
|
||||
target_include_directories(amgcbind PUBLIC
|
||||
$<BUILD_INTERFACE:${CMAKE_BINARY_DIR}/modules>
|
||||
$<INSTALL_INTERFACE:modules>)
|
||||
|
||||
message(STATUS "include dir := ${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_INCLUDEDIR}")
|
||||
|
||||
#target_include_directories(base PUBLIC ${CMAKE_Fortran_MODULE_DIRECTORY})
|
||||
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
install(DIRECTORY ${CMAKE_BINARY_DIR}/include/ DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}"
|
||||
FILES_MATCHING PATTERN "*.h")
|
||||
|
||||
install(DIRECTORY ${CMAKE_BINARY_DIR}/modules/ DESTINATION "${CMAKE_INSTALL_MODULDIR}"
|
||||
FILES_MATCHING PATTERN "*.mod")
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# Install the library
|
||||
install(TARGETS amgprec amgcbind
|
||||
EXPORT ${CMAKE_PROJECT_NAME}-targets
|
||||
DESTINATION "${CMAKE_INSTALL_LIBDIR}"
|
||||
LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}"
|
||||
)
|
||||
|
||||
|
||||
|
||||
if(WIN32) #TODO
|
||||
# install(TARGETS psb_base_C
|
||||
# EXPORT ${CMAKE_PROJECT_NAME}-targets
|
||||
# DESTINATION "${CMAKE_INSTALL_LIBDIR}"
|
||||
# LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}"
|
||||
# )
|
||||
# if(METIS_FOUND)
|
||||
# install(TARGETS psb_util_C
|
||||
# EXPORT ${CMAKE_PROJECT_NAME}-targets
|
||||
# DESTINATION "${CMAKE_INSTALL_LIBDIR}"
|
||||
# LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}"
|
||||
# )
|
||||
# endif()
|
||||
endif()
|
||||
|
||||
|
||||
message(STATUS "install directory is ${CMAKE_INSTALL_LIBDIR};;;")
|
||||
|
||||
# Step 2: Create the configuration file from the template
|
||||
#configure_package_config_file(
|
||||
# "${CMAKE_CURRENT_SOURCE_DIR}/cmake/amg4psblasConfig.cmake.in"
|
||||
# "${CMAKE_CURRENT_BINARY_DIR}/amg4psblasConfig.cmake"
|
||||
# INSTALL_DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/amg4psblas"
|
||||
#)
|
||||
|
||||
# Step 3: Install the generated config files
|
||||
#install(FILES
|
||||
# "${CMAKE_CURRENT_BINARY_DIR}/amg4psblasConfig.cmake"
|
||||
# "${CMAKE_CURRENT_BINARY_DIR}/amg4psblasConfigVersion.cmake"
|
||||
# DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/amg4psblas"
|
||||
#)
|
||||
|
||||
# Step 4: Export targets so that the build directory can be used directly
|
||||
#export(
|
||||
# EXPORT ${CMAKE_PROJECT_NAME}-targets
|
||||
# FILE "${CMAKE_CURRENT_BINARY_DIR}/amg4psblasTargets.cmake"
|
||||
# NAMESPACE psblas::
|
||||
#)
|
||||
export(
|
||||
EXPORT ${CMAKE_PROJECT_NAME}-targets
|
||||
FILE "${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_PROJECT_NAME}Targets.cmake"
|
||||
NAMESPACE ${CMAKE_PROJECT_NAME}::
|
||||
)
|
||||
|
||||
#export(
|
||||
# EXPORT ${CMAKE_PROJECT_NAME}-targets
|
||||
# FILE "${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_PROJECT_NAME}Targets.cmake"
|
||||
# NAMESPACE ${CMAKE_PROJECT_NAME}::
|
||||
#)
|
||||
|
||||
|
||||
|
||||
|
||||
# Set the installation directory for the test files
|
||||
set(INSTALL_TEST_DIR "${CMAKE_INSTALL_PREFIX}/samples" CACHE PATH "Installation directory for sample files")
|
||||
|
||||
function(install_directory_recursive source_dir install_base_dir) # Function to install a directory and its subdirectories recursively
|
||||
file(GLOB_RECURSE ALL_FILES RELATIVE "${CMAKE_CURRENT_SOURCE_DIR}/${source_dir}" "${source_dir}/*")
|
||||
|
||||
foreach(FILE_PATH IN LISTS ALL_FILES)
|
||||
# Construct the full source and destination paths
|
||||
set(FULL_SOURCE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/${source_dir}/${FILE_PATH}")
|
||||
set(FULL_INSTALL_PATH "${install_base_dir}/${FILE_PATH}")
|
||||
|
||||
# Check if it's a directory
|
||||
if(IS_DIRECTORY "${FULL_SOURCE_PATH}")
|
||||
# Create the directory in the install destination
|
||||
file(MAKE_DIRECTORY "${FULL_INSTALL_PATH}")
|
||||
else()
|
||||
# Install the file
|
||||
install(FILES "${FULL_SOURCE_PATH}" DESTINATION "${install_base_dir}" RENAME "${FILE_PATH}")
|
||||
endif()
|
||||
endforeach()
|
||||
endfunction()
|
||||
|
||||
|
||||
|
||||
# Install test/fileread directory
|
||||
install_directory_recursive(samples/simple "${INSTALL_TEST_DIR}/simple")
|
||||
|
||||
# Install test/pdegen directory
|
||||
install_directory_recursive(samples/advanced "${INSTALL_TEST_DIR}/advanced")
|
||||
|
||||
|
||||
|
||||
message(STATUS "CMAKE_INSTALL_PREFIX: ${CMAKE_INSTALL_PREFIX} - ${PSB_CMAKE_INSTALL_PREFIX};")
|
||||
message(STATUS "CMAKE_INSTALL_LIBDIR: ${CMAKE_INSTALL_LIBDIR} - ${PSB_CMAKE_INSTALL_LIBDIR};")
|
||||
message(STATUS "CMAKE_INSTALL_INCLUDEDIR: ${CMAKE_INSTALL_INCLUDEDIR} - ${PSB_CMAKE_INSTALL_INCLUDEDIR};")
|
||||
message(STATUS "CMAKE_INSTALL_MODULDIR: ${CMAKE_INSTALL_MODULDIR} - ${PSB_CMAKE_INSTALL_MODULDIR};")
|
||||
|
||||
@@ -0,0 +1,164 @@
|
||||
Changelog. A lot less detailed than usual, at least for past
|
||||
history.
|
||||
2018/10/28: Fix interface to MUMPS and configry machinery. Require PSB 3.6.
|
||||
2018/10/10: ICTXT argument in prec%init().
|
||||
2018/07/30: Fixes for Intel compilers. BootCMatch interface in examples.
|
||||
2018/05/14: Interface for extension of aggregation methods.
|
||||
2018/02/28: New cartesian distribution for sample programs.
|
||||
2017/12/15: New WRK component of preconditioner levels, preallocation.
|
||||
2017/10/25: New example input file formats. Added sample matrices.
|
||||
2017/10/02: New CBIND in PSBLAS 3.5.0
|
||||
2017/07/30: Refactored examples. Change default thresholds.
|
||||
2017/05/31: New internal description of ML.
|
||||
2017/05/16: Improve build process.
|
||||
2017/04/20: Force %set interface. Update docs.
|
||||
2017/04/03: Remove obsolete stuff.
|
||||
2017/03/17: Fixed level%cnv; add coarse _solver tracker.
|
||||
2017/02/18: Take out clean_zeros; changed NOFILTER; defined FBGS; take out
|
||||
n_prec_levs.
|
||||
2017/02/12: Updated mat_dist usage, dubious SP shell for UMFPACK, fixes
|
||||
for RPM packaging.
|
||||
2017/02/02: Fix superlu configury
|
||||
2016/11/12: Fix hierarchy/smoothers build to handle 1 level.
|
||||
2016/10/03: Merged changes to hierearchy building.
|
||||
2016/08/20: Reimplemented decoupled aggregation
|
||||
2016/07/20: Refactored application of multilevel. Defined V,W and
|
||||
K-cycles.
|
||||
2016/05/18: Reworked internals of PRECSET. Defined Forward-Backward
|
||||
Gauss-Seidel solver. Now available separate PRE and POST smoother
|
||||
objects.
|
||||
2016/03/30: MUMPS interface.
|
||||
2016/02/28: Hybrid Gauss-Seidel method.
|
||||
2016/02/03: unify integer argument checks.
|
||||
2015/12/15: defaults single vs. double precision. Use clean_zeros.
|
||||
2015/12/08: new matdist interface
|
||||
2015/10/17: configry fixes
|
||||
2015/10/13: Fixes for SLUDIST versions 3 and 4
|
||||
2015/05/03: New heap interface
|
||||
2015/04/21: INTENT fixes
|
||||
|
||||
2014/12/21: New error handling
|
||||
|
||||
2014/10/27: Added versioncheck to configure.
|
||||
|
||||
2014/03/31: New get_diag.
|
||||
|
||||
2013/11/07: Merged changes from experimental branch. Fix INCDIR in
|
||||
makefiles.
|
||||
|
||||
2013/07/15: Fixes for UMFPACK 5.4, SuperLU 4.3, SuperLU_Dist 3.3
|
||||
|
||||
2013/04/05: CLONE method.
|
||||
|
||||
2013/03/08: Reworked SET routines.
|
||||
|
||||
2012/12/10: Enable long_integers.
|
||||
|
||||
2012/12/05: Split smoother/solver objects.
|
||||
|
||||
2012/04/30: New scheme to find dynamically the number of level based on
|
||||
the size of the coarse matrix
|
||||
|
||||
2012/01/10: Done split interface/implementation, plus subdir restructure.
|
||||
|
||||
2011/12/13: Start split interface/implementation to improve build time.
|
||||
|
||||
2011/11/25: Now works with _vect methods from PSBLAS.
|
||||
|
||||
2011/10/24: New test generation methods.
|
||||
|
||||
2011/06/15: Dump prolongator/restrictor
|
||||
|
||||
2011/04/14: Added MOLD argument(s) to precbld.
|
||||
|
||||
2011/03/30: Fixed: descriptive methods, example programs.
|
||||
|
||||
2011/03/08: Re-factored modules for ILU methods.
|
||||
|
||||
2011/03/04: Make X intent(inout) in APPLY to allow for preconditioners
|
||||
using SPMM.
|
||||
|
||||
2011/03/02: New set methods.
|
||||
|
||||
2011/01/07: Fixed UMF interfacing for Z data.
|
||||
|
||||
2011/01/04: Added UMF inteface for D data.
|
||||
|
||||
2011/01/02: Fix usage of DESC_DATA. Switched all names to F90 ending.
|
||||
|
||||
2010/12/16: Fix usage of replicated space descriptor.
|
||||
|
||||
2010/11/16: Fix Jacobi smoother in case of empty off-diagonal.
|
||||
|
||||
2010/11/04: Defined and tested single real and complex.
|
||||
|
||||
2010/11/02: Aligned usage of sparse data type with psblas3.
|
||||
|
||||
2009/12/22: Aligned constants with mld2p4 v1.2
|
||||
|
||||
2009/12/11: First working version of double multilevel.
|
||||
|
||||
2009/12/05: Inttroduction of Smoother/Solver object hierarchy.
|
||||
|
||||
2009/09/23: Initial F2003 version.
|
||||
|
||||
|
||||
2009/01/28: Changed names from XbaseprcY to XbaseprecY.
|
||||
2009/01/27: Changed names from mld_transfer to mld_move_alloc.
|
||||
|
||||
2009/01/13: Repackaged the one-level preconditioners. Reorganized the
|
||||
build routines, taking out mlprec_bld, and switching the
|
||||
number of levels when needed.
|
||||
2008/10/27: Changed the definition of prec_type: repackaged with a
|
||||
onelev-prec-type, containing a baseprec and maps between
|
||||
index spaces. No performance impact; no changes to
|
||||
user-level interfaces.
|
||||
|
||||
2008/09/18: Changed mld_sizeof to integer(8); updated samples.
|
||||
|
||||
2008/08/26: Fixed matrix generation in sample programs.
|
||||
|
||||
2008/07/25: missing implicit none in mld_prec_type.
|
||||
|
||||
2008/07/23: added HTML documentation
|
||||
|
||||
2008/06/13: Fixed aggregation for replicated index spaces.
|
||||
|
||||
2008/06/02: Threshold into decoupled aggregation algorithm.
|
||||
|
||||
2008/05/27: Single precision version.
|
||||
|
||||
2008/03/09: Introduced configure script.
|
||||
|
||||
2008/02/08: Merged changes from intermesh branch: we now have an
|
||||
inter_desc_type object. Cleaned up data allocation and
|
||||
variable initialization in multilevel prec application.
|
||||
|
||||
2008/01/10: Merged various fixes for: prologues, unused variables,
|
||||
interface details.
|
||||
2007/12/21: Merge version with prologues and internal docs.
|
||||
|
||||
2007/11/15: Created pargen example.
|
||||
|
||||
2007/11/14: Fix INTENT(IN) on X vector in preconditioner routines.
|
||||
|
||||
2007/10/19: Merged in ILU(P,T). To be tested extensively.
|
||||
|
||||
2007/10/17: Merged ILU(K) into trunk.
|
||||
|
||||
2007/10/16: Fixed ILU(K), it now performs satisfactorily. Also updated
|
||||
ILU(0) to be more legible.
|
||||
|
||||
2007/10/11: First working version of ILU(K). Still slow, there should
|
||||
be room for improvement.
|
||||
|
||||
2007/10/09: Added benchmark code.
|
||||
|
||||
2007/10/09: Added MILU_N_. Beware: values for UMF_ etc. have been
|
||||
shifted.
|
||||
|
||||
2007/10/02: To do: decide whether to name MLD_KRYLOV_MOD or
|
||||
PSB_KRYLOV_MOD.
|
||||
|
||||
2007/10/01: Start of this changelog. MLD2P4 now has a different
|
||||
structure, to enable a build not embedded in PSBLAS.
|
||||
@@ -1,13 +1,15 @@
|
||||
|
||||
|
||||
AMG4PSBLAS version 1.2
|
||||
AMG4PSBLAS version 1.0
|
||||
Algebraic Multigrid Package
|
||||
based on PSBLAS (Parallel Sparse BLAS version 3.9)
|
||||
|
||||
(C) Copyright 2025 Salvatore Filippone
|
||||
(C) Copyright 2025 Pasqua D'Ambra
|
||||
(C) Copyright 2025 Fabio Durastante
|
||||
based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
|
||||
(C) Copyright 2020
|
||||
|
||||
Salvatore Filippone
|
||||
Pasqua D'Ambra
|
||||
Fabio Durastante
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
@@ -18,7 +20,7 @@
|
||||
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.
|
||||
software without specific written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
+8
-11
@@ -2,10 +2,10 @@
|
||||
.mod=@MODEXT@
|
||||
.fh=.fh
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .f90 .F90 .f .F .c .cpp .o
|
||||
.SUFFIXES: .f90 .F90 .f .F .c .o
|
||||
##########################################################
|
||||
# #
|
||||
# Note: directories external to the AMG4PSBLAS subtree #
|
||||
# Note: directories external to the MLD2P4 subtree #
|
||||
# must be specified here with absolute pathnames #
|
||||
# #
|
||||
##########################################################
|
||||
@@ -16,7 +16,6 @@ PSBLAS_LIBDIR=@PSBLAS_LIBDIR@
|
||||
@PSBLAS_INSTALL_MAKEINC@
|
||||
PSBLAS_INCLUDES=@PSBLAS_INCLUDES@
|
||||
PSBLAS_LIBS=@PSBLAS_LIBS@
|
||||
PSBBASEMODNAME=psb_base_mod
|
||||
|
||||
|
||||
|
||||
@@ -70,17 +69,15 @@ EXTRALIBS=@EXTRA_LIBS@
|
||||
|
||||
|
||||
#
|
||||
AMGCDEFINES=$(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS)
|
||||
#$(PSBCDEFINES) $(MUMPSFLAGS)
|
||||
CDEFINES=$(AMGCDEFINES)
|
||||
AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
|
||||
FDEFINES=$(AMGFDEFINES)
|
||||
MLDCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
|
||||
MLDFDEFINES=@FDEFINES@ $(PSBFDEFINES)
|
||||
|
||||
CXXDEFINES=@AMGCXXDEFINES@ $(PSBCXXDEFINES)
|
||||
CDEFINES=$(MLDCDEFINES)
|
||||
FDEFINES=$(MLDFDEFINES)
|
||||
|
||||
@COMPILERULES@
|
||||
|
||||
|
||||
AMGLDLIBS=$(MUMPSLIBS) $(SLULIBS) $(SLUDISTLIBS) $(UMFLIBS) $(EXTRALIBS) $(PSBLDLIBS) -lstdc++
|
||||
LDLIBS=$(AMGLDLIBS)
|
||||
MLDLDLIBS=$(MUMPSLIBS) $(SLULIBS) $(SLUDISTLIBS) $(UMFLIBS) $(EXTRALIBS) $(PSBLDLIBS)
|
||||
LDLIBS=$(MLDLDLIBS)
|
||||
|
||||
|
||||
-120
@@ -1,120 +0,0 @@
|
||||
##########################################################
|
||||
.mod=@MODEXT@
|
||||
.fh=.fh
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .f90 .F90 .f .F .c .cpp .o
|
||||
# The following ones are the variables used by the PSBLAS make scripts.
|
||||
|
||||
FC=@FC@
|
||||
CC=@CC@
|
||||
CXX=@CXX@
|
||||
FCOPT=@FCOPT@
|
||||
CCOPT=@CCOPT@
|
||||
CXXOPT=@CXXOPT@
|
||||
FMFLAG=@FMFLAG@
|
||||
FIFLAG=@FIFLAG@
|
||||
EXTRA_OPT=@EXTRA_OPT@
|
||||
|
||||
# These three should be always set!
|
||||
MPFC=@MPIFC@
|
||||
MPCC=@MPICC@
|
||||
MPCXX=@MPICXX@
|
||||
|
||||
FLINK=@FLINK@
|
||||
|
||||
LIBS=@LIBS@
|
||||
|
||||
# BLAS, BLACS and METIS libraries.
|
||||
BLAS=@BLAS_LIBS@
|
||||
METIS_LIB=@METIS_LIBS@
|
||||
LAPACK=@LAPACK_LIBS@
|
||||
|
||||
PSBFDEFINES=@FDEFINES@
|
||||
PSBCDEFINES=@CDEFINES@
|
||||
PSBCXXDEFINES=@CDEFINES@
|
||||
AR=@AR@
|
||||
RANLIB=@RANLIB@
|
||||
|
||||
##########################################################
|
||||
# #
|
||||
# Note: directories external to the AMG4PSBLAS subtree #
|
||||
# must be specified here with absolute pathnames #
|
||||
# #
|
||||
##########################################################
|
||||
PSBLASDIR=@PSBLAS_DIR@
|
||||
PSBLAS_INCDIR=@PSBLAS_INCDIR@
|
||||
PSBLAS_MODDIR=@PSBLAS_MODDIR@
|
||||
PSBLAS_LIBDIR=@PSBLAS_LIBDIR@
|
||||
PSBLAS_INCLUDES=@PSBLAS_INCLUDES@
|
||||
PSBLAS_LIBS=@PSBLAS_LIBS@
|
||||
PSBBASEMODNAME=psb_base_mod
|
||||
PSBPRECMODNAME=psb_prec_mod
|
||||
PSBMETHDMODNAME=psb_linsolve_mod
|
||||
PSBUTILMODNAME=psb_util_mod
|
||||
|
||||
|
||||
|
||||
|
||||
INSTALL=@INSTALL@
|
||||
INSTALL_DATA=@INSTALL_DATA@
|
||||
INSTALL_DIR=@INSTALL_DIR@
|
||||
INSTALL_LIBDIR=@INSTALL_LIBDIR@
|
||||
INSTALL_INCLUDEDIR=@INSTALL_INCLUDEDIR@
|
||||
INSTALL_MODULESDIR=@INSTALL_MODULESDIR@
|
||||
INSTALL_DOCSDIR=@INSTALL_DOCSDIR@
|
||||
INSTALL_SAMPLESDIR=@INSTALL_SAMPLESDIR@
|
||||
|
||||
|
||||
##########################################################
|
||||
# #
|
||||
# Additional defines and libraries for multilevel #
|
||||
# Note that these libraries should be compatible #
|
||||
# (compiled with) the compilers specified in the #
|
||||
# PSBLAS main Make.inc #
|
||||
# #
|
||||
# Examples: #
|
||||
# MUMPSLIBS=-ldmumps -lmumps_common #
|
||||
# -lpord -L/path/to/MUMPS/lib #
|
||||
# MUMPSFLAGS=-DHave_MUMPS_ -I/path/to/MUMPS/include #
|
||||
# #
|
||||
# UMFLIBS=-lumfpack -lamd -L/path/to/UMFPACK #
|
||||
# UMFFLAGS=-DHave_UMF_ -I/path/to/UMFPACK #
|
||||
# #
|
||||
# SLULIBS=-lslu -L/path/to/SuperLU #
|
||||
# SLUFLAGS=-DHave_SLU_ -I/path/to/SuperLU #
|
||||
# #
|
||||
# SLUDISTLIBS=-lslud -L/path/to/SuperLUDist #
|
||||
# SLUDISTFLAGS=-DHave_SLUDist_ -I/path/to/SuperLUDist #
|
||||
# #
|
||||
##########################################################
|
||||
|
||||
MUMPSLIBS=@MUMPS_LIBS@
|
||||
MUMPSFLAGS=@MUMPS_FLAGS@
|
||||
|
||||
SLULIBS=@SLU_LIBS@
|
||||
SLUFLAGS=@SLU_FLAGS@
|
||||
|
||||
SLUDISTLIBS=@SLUDIST_LIBS@
|
||||
SLUDISTFLAGS=@SLUDIST_FLAGS@
|
||||
|
||||
UMFLIBS=@UMF_LIBS@
|
||||
UMFFLAGS=@UMF_FLAGS@
|
||||
|
||||
EXTRALIBS=@EXTRA_LIBS@
|
||||
|
||||
|
||||
|
||||
@COMPILERULES@
|
||||
|
||||
#
|
||||
AMGCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
|
||||
CDEFINES=$(AMGCDEFINES)
|
||||
AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
|
||||
FDEFINES=$(AMGFDEFINES)
|
||||
|
||||
CXXDEFINES=@AMGCXXDEFINES@ $(PSBCXXDEFINES)
|
||||
|
||||
AMGLDLIBS=$(MUMPSLIBS) $(SLULIBS) $(SLUDISTLIBS) $(UMFLIBS) $(EXTRALIBS) $(PSBLDLIBS) -lstdc++
|
||||
LDLIBS=$(AMGLDLIBS)
|
||||
|
||||
|
||||
@@ -1,14 +1,10 @@
|
||||
include Make.inc
|
||||
|
||||
|
||||
all: mods objs lib
|
||||
all: library
|
||||
|
||||
objs: libdir mods amgobjs cbnd
|
||||
mods: libdir
|
||||
cd amgprec && $(MAKE) mods
|
||||
lib: objs
|
||||
cd amgprec && $(MAKE) lib
|
||||
cd cbind && $(MAKE) lib
|
||||
library: libdir amgp
|
||||
#cbnd
|
||||
|
||||
libdir:
|
||||
(if test ! -d lib ; then mkdir lib; fi)
|
||||
@@ -16,12 +12,11 @@ libdir:
|
||||
(if test ! -d modules ; then mkdir modules; fi;)
|
||||
($(INSTALL_DATA) Make.inc include/Make.inc.amg4psblas)
|
||||
|
||||
amgobjs: mods
|
||||
cd amgprec && $(MAKE) objs
|
||||
|
||||
cbnd: amgobjs
|
||||
cd cbind && $(MAKE) objs
|
||||
|
||||
amgp:
|
||||
$(MAKE) -C amgprec all
|
||||
cbnd: amgp
|
||||
$(MAKE) -C cbind all
|
||||
install: all
|
||||
mkdir -p $(INSTALL_LIBDIR) &&\
|
||||
$(INSTALL_DATA) lib/*.a $(INSTALL_LIBDIR)
|
||||
@@ -38,25 +33,22 @@ install: all
|
||||
mkdir -p $(INSTALL_SAMPLESDIR) && \
|
||||
mkdir -p $(INSTALL_SAMPLESDIR)/simple &&\
|
||||
mkdir -p $(INSTALL_SAMPLESDIR)/advanced && \
|
||||
(cd samples/simple; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/simple ) && \
|
||||
(cd samples/advanced; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/advanced )
|
||||
(cd examples; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/simple ) && \
|
||||
(cd tests; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/advanced )
|
||||
cleanlib:
|
||||
(cd lib; /bin/rm -f *.a *$(.mod) *$(.fh))
|
||||
(cd include; /bin/rm -f *.a *$(.mod) *$(.fh))
|
||||
(cd modules; /bin/rm -f *.a *$(.mod) *$(.fh))
|
||||
|
||||
distclean: clean samplesclean
|
||||
/bin/rm -fr Make.inc amgprec/amg_config.h
|
||||
|
||||
samplesclean: clean
|
||||
(cd samples/simple/fileread && $(MAKE) clean)
|
||||
(cd samples/simple/pdegen && $(MAKE) clean)
|
||||
(cd samples/advanced/fileread && $(MAKE) clean)
|
||||
(cd samples/advanced/pdegen && $(MAKE) clean)
|
||||
veryclean: cleanlib
|
||||
(cd amgprec; make veryclean)
|
||||
(cd examples/fileread; make clean)
|
||||
(cd examples/pdegen; make clean)
|
||||
(cd tests/fileread; make clean)
|
||||
(cd tests/pdegen; make clean)
|
||||
|
||||
check: all
|
||||
make check -C samples/advanced/pdegen
|
||||
make check -C tests/pdegen
|
||||
|
||||
clean: cleanlib
|
||||
(cd amgprec && $(MAKE) veryclean)
|
||||
(cd cbind && $(MAKE) veryclean)
|
||||
clean:
|
||||
(cd amgprec; make clean)
|
||||
|
||||
@@ -1,166 +1,55 @@
|
||||
# AMG4PSBLAS v1.2
|
||||
Algebraic Multigrid Package based on [PSBLAS](https://github.com/sfilippone/psblas3) (Parallel Sparse BLAS version 3.9)
|
||||
|
||||
AMG4PSBLAS is a package of parallel algebraic multilevel preconditioners included in
|
||||
the PSCToolkit (Parallel Sparse Computation Toolkit) software framework.
|
||||
AMG4PSBLAS
|
||||
Algebraic Multigrid Package based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
|
||||
Salvatore Filippone (University of Rome Tor Vergata and IAC-CNR)
|
||||
Pasqua D'Ambra (IAC-CNR, Naples, IT)
|
||||
Fabio Durastante (IAC-CNR, Naples, IT)
|
||||
|
||||
It is the prosecution of a software development project called MLD2P4 that started in 2007,
|
||||
which originally implemented a multilevel version of some domain decomposition preconditioners
|
||||
of additive-Schwarz type and was based on a parallel decoupled version of the well known
|
||||
smoothed aggregation method to generate the multilevel hierarchy of coarser matrices.
|
||||
---------------------------------------------------------------------
|
||||
|
||||
In the last few years the package was extended by including new algorithms and functionalities
|
||||
for the setup and application new AMG preconditioners with the final goal of improving efficiency
|
||||
and scalability when using tens of thousands cores and boosting reliability in dealing
|
||||
with general symmetric positive definite linear systems.
|
||||
AMG4PSBLAS is a package of Algebraic MultiGrid (AMG)
|
||||
preconditioners for the iterative solution of large and sparse linear systems.
|
||||
|
||||
The original license is shown in the file [LICENSE.MLD2P4](LICENSE.MLD2P4); due to the
|
||||
significant number of changes and the vast enlargement in scope, we decided to rename
|
||||
the package as AMG4PSBLAS.
|
||||
It is an evolution of MLD2P4 (see LICENSE.MLD2P4), but it has been
|
||||
thoroughly reworked, and it is sufficiently different to warrant a new
|
||||
project name.
|
||||
|
||||
AMG4PSBLAS has been designed to provide scalable and easy-to-use preconditioners in the context
|
||||
of the PSBLAS (Parallel Sparse Basic Linear Algebra Subprograms) computational framework and can be
|
||||
used in conjuction with the Krylov solvers available in this framework. Our package is based on
|
||||
a completely algebraic approach; therefore users level interfaces assume that the system matrix
|
||||
and preconditioners are represented as PSBLAS distributed sparse matrices.
|
||||
|
||||
AMG4PSBLAS enables the user to easily specify different features of an algebraic multilevel preconditioner,
|
||||
thus allowing to experiment with different preconditioners for the problem and parallel computers at hand.
|
||||
MAIN REFERENCES:
|
||||
|
||||
The package employs object-oriented design techniques in Fortran 2008, with interfaces to additional third
|
||||
party libraries such as MUMPS, UMFPACK, SuperLU, and SuperLU_Dist, which can be exploited in building
|
||||
multilevel preconditioners. The parallel implementation is based on a Single Program Multiple Data (SPMD)
|
||||
paradigm; the inter-process communication is based on MPI and is managed mainly through PSBLAS.
|
||||
|
||||
|
||||
## Main Refrerences:
|
||||
P. D'Ambra, D. di Serafino, S. Filippone,
|
||||
MLD2P4: a Package of Parallel Algebraic Multilevel Domain Decomposition
|
||||
Preconditioners in Fortran 95,
|
||||
ACM Transactions on Mathematical Software, 37 (3), 2010, art. 30,
|
||||
doi: 10.1145/1824801.1824808.
|
||||
|
||||
The main reference for this project is
|
||||
> D'Ambra, P., Durastante, F., & Filippone, S. (2021). AMG preconditioners for linear solvers towards extreme scale. SIAM Journal on Scientific Computing, 43(5), S679-S703.
|
||||
|
||||
AMG4PSBLAS is the suite of preconditioners for the Parallel Sparse Computation Toolkit ([PSCToolkit](https://psctoolkit.github.io/)) suite of libraries. See the paper:
|
||||
> D’Ambra, P., Durastante, F., & Filippone, S. (2023). Parallel Sparse Computation Toolkit. Software Impacts, 15, 100463.
|
||||
|
||||
The main reference for features inherited from MLD2P4 is
|
||||
> P. D'Ambra, D. di Serafino, S. Filippone,
|
||||
> MLD2P4: a Package of Parallel Algebraic Multilevel Domain Decomposition
|
||||
> Preconditioners in Fortran 95,
|
||||
> ACM Transactions on Mathematical Software, 37 (3), 2010, art. 30,
|
||||
> doi: 10.1145/1824801.1824808.
|
||||
|
||||
## Installing
|
||||
|
||||
Installation requires a working version of the [PSBLAS](https://github.com/sfilippone/psblas3) library
|
||||
as a prerequisite.
|
||||
AMG4PSBLAS has several interfaces to third-party libraries that can be used in the construction
|
||||
and application phases of preconditioners;
|
||||
in particular, it is possible to link AMG4PSBLAS with the libraries: MUMPS, SuperLU, SuperLU_Dist, UMFPACK.
|
||||
The usage of these third party libraries is _not mandatory_: the package can function
|
||||
in isolation and without these features.
|
||||
TO COMPILE
|
||||
|
||||
0. Unpack the tar file in a directory of your choice (preferrably
|
||||
outside the main PSBLAS directory).
|
||||
1. run configure `--with-psblas=<ABSOLUTE path of the PSBLAS install directory> --prefix=<install_path>`
|
||||
1. run configure --with-psblas=<ABSOLUTE path of the PSBLAS install directory>
|
||||
adding the options for MUMPS, SuperLU, SuperLU_Dist, UMFPACK as desired.
|
||||
See [AMG4PSBLAS User's and Reference Guide](docs/amg4psblas_1.2-guide.pdf) (Section 3) for details.
|
||||
2. Tweak `Make.inc` if you are not satisfied.
|
||||
3. run `make`;
|
||||
See MLD2P4 User's and Reference Guide (Section 3) for details.
|
||||
2. Tweak Make.inc if you are not satisfied.
|
||||
3. make;
|
||||
4. Go into the test subdirectory and build the examples of your choice.
|
||||
5. (if desired): `make install` or `sudo make install` if the install path requires privileged access.
|
||||
|
||||
>[!CAUTION]
|
||||
>The single precision version is supported only by MUMPS and SuperLU;
|
||||
>thus, even if you specify at configure time to use UMFPACK or SuperLU_Dist,
|
||||
>the corresponding preconditioner options will be available only from
|
||||
>the double precision version.
|
||||
|
||||
## CMAKE
|
||||
AMG4PSBLAS supports building with CMake. To configure the project, you must explicitly provide the path where PSBLAS is installed. If this path is not specified, the configuration will fail with a fatal error.
|
||||
|
||||
From the root directory of the project, run:
|
||||
### 1. Create and enter the build directory
|
||||
```
|
||||
mkdir build
|
||||
cd build
|
||||
```
|
||||
|
||||
### 2. Configure the project (MANDATORY: specify your PSBLAS path)
|
||||
```
|
||||
cmake -DPSBLAS_INSTALL_DIR=</path/to/psblas/installation> ..
|
||||
```
|
||||
During this step, CMake will:
|
||||
- Search for the PSBLAS package in the provided path.
|
||||
- Detect and configure MPI (required for C, C++, and Fortran).
|
||||
- Set up include and module directories based on the PSBLAS configuration.
|
||||
- Configure integer sizes (IPK and LPK) to match the PSBLAS installation.
|
||||
### 2.1. Customizing the Installation Path
|
||||
By default, the library will be installed in standard system locations. To install amg4psblas in a custom directory, use the CMAKE_INSTALL_PREFIX variable:
|
||||
```
|
||||
cmake -DPSBLAS_INSTALL_DIR=</path/to/psblas/installation> \
|
||||
-DCMAKE_INSTALL_PREFIX=</path/to/amg4psblas_install> ..
|
||||
```
|
||||
|
||||
### 3. Compiling and Installing
|
||||
Once configured, you can build the libraries (amg_prec and amg_cbind) and install them.
|
||||
#### Build the library
|
||||
```
|
||||
make
|
||||
```
|
||||
|
||||
#### Install the library, modules, and samples
|
||||
```
|
||||
make install
|
||||
```
|
||||
5. (if desired): make install
|
||||
|
||||
|
||||
### CUDA, OpeMP, OpenACC
|
||||
NOTES
|
||||
|
||||
CUDA, OpenMP and OpenACC features are transparently inherited by PSBLAS installation.
|
||||
If PSBLAS has been configured (and installed) with these supports then AMG4PSBLAS will
|
||||
transparently inherit them. It will then be possible to move the computation to GPU accelerator
|
||||
simply by selecting the appropriate variable types in the application.
|
||||
If the types have not been activated or installed for PSBLAS then they will not be
|
||||
available for AMG4PSBLAS either and the operation will be purely on CPU/MPI. See also the samples/cuda folder.
|
||||
- The single precision version is supported only by MUMPS and SuperLU;
|
||||
thus, even if you specify at configure time to use UMFPACK or SuperLU_Dist,
|
||||
the corresponding preconditioner options will be available only from
|
||||
the double precision version.
|
||||
|
||||
### EoCoE - Software as service portal
|
||||
|
||||
In the European project “Energy oriented Center of Excellence: toward exascale for energy” we made
|
||||
available the software through a service portal: [https://eocoe.psnc.pl/](https://eocoe.psnc.pl/).
|
||||
This permits to test several cutting-edge computational methods for accelerating the transition
|
||||
to production, storage and management of clean, decarbonized energy.
|
||||
Among them you have the possibility of running PSBLAS+AMG4PSBLAS on some test problems
|
||||
to become familiar with using the software.
|
||||
## MPI and Compilers
|
||||
The library has been successfully compiled and tested with the same compilers
|
||||
and MPI implementations as PSBLAS 3.9, which include:
|
||||
- MPICH 4.2.3, 4.3.0, 4.3.2
|
||||
- OpenMPI 4.1.8. 5.0.7, 5.0.8, 5.0.9
|
||||
|
||||
combined with
|
||||
|
||||
- GNU compilers 10.5.0, 11.5.0, 12.5.0, 13.3.0, 14.2.0 14.3.0, 15.2.0
|
||||
- LLVM 20.1.0 and 21.1.0 (except OpenMPI 4.1.8 which does not build with LLVM)
|
||||
|
||||
Moreover, it has been tested with the Intel OneAPI toolchain versions 2025.2 and 2025.3
|
||||
|
||||
As of this release, the NVIDIA compiler 25.7 fails to handle our code.
|
||||
Cray, IBM and NAg compilers have been used for testing in the past, but not on this version.
|
||||
|
||||
## TODO and bugs
|
||||
|
||||
- [X] Fix all reamining bugs. Bugs? We dont' have any ! 🤓
|
||||
|
||||
> [!NOTE]
|
||||
> To report bugs 🐛 or issues ❓ please use the [GitHub issue system](https://github.com/sfilippone/amg4psblas/issues).
|
||||
|
||||
## The AMG4PSBLAS team.
|
||||
|
||||
- Pasqua D'Ambra (IAC-CNR, Naples, IT)
|
||||
- Fabio Durastante (University of Pisa and IAC-CNR, IT)
|
||||
- Salvatore Filippone (University of Rome Tor Vergata and IAC-CNR, IT)
|
||||
|
||||
**Contributors** (_roughly reverse cronological order_):
|
||||
|
||||
- Luca Pepè Sciarria
|
||||
- Andrea Di Iorio
|
||||
- Ambra Abdullahi Hassan
|
||||
- Alfredo Buttari
|
||||
The AMG4PSBLAS team.
|
||||
---------------
|
||||
Salvatore Filippone
|
||||
Pasqua D'Ambra
|
||||
Fabio Durastante
|
||||
|
||||
-14
@@ -1,19 +1,5 @@
|
||||
WHAT'S NEW
|
||||
|
||||
AMG4PSBLAS
|
||||
Version 1.2
|
||||
1. New polynomial smoothers.
|
||||
2. Introduced L1-variants
|
||||
3. Reorganization of sample programs.
|
||||
|
||||
Version 1.1
|
||||
1. Reworked approximate inverse solvers.
|
||||
|
||||
|
||||
Version 1.0
|
||||
1. Transitioned from MLD2P4
|
||||
|
||||
MLD2P4
|
||||
Version 2.1
|
||||
1. The multigrid preconditioner now include fully general V- and
|
||||
W-cycles. We also support K-cycles, both for symmetric and
|
||||
|
||||
@@ -1,907 +0,0 @@
|
||||
set(AMG_amgprec_source_files
|
||||
amg_s_ainv_solver.F90
|
||||
amg_d_ainv_solver.F90
|
||||
amg_z_base_solver_mod.f90
|
||||
amg_z_slu_solver.F90
|
||||
amg_z_gs_solver.f90
|
||||
amg_d_ilu_fact_mod.f90
|
||||
# amg_z_hybrid_aggregator_mod.F90
|
||||
amg_c_base_smoother_mod.f90
|
||||
amg_s_matchboxp_mod.F90
|
||||
amg_c_gs_solver.f90
|
||||
amg_z_prec_type.f90
|
||||
amg_s_base_solver_mod.f90
|
||||
amg_d_slu_solver.F90
|
||||
amg_z_inner_mod.f90
|
||||
amg_d_base_aggregator_mod.f90
|
||||
amg_c_diag_solver.f90
|
||||
amg_z_krm_solver.f90
|
||||
impl/amg_zfile_prec_descr.f90
|
||||
impl/amg_c_hierarchy_rebld.f90
|
||||
impl/amg_dcprecset.F90
|
||||
impl/amg_sprecinit.F90
|
||||
impl/amg_cprecinit.F90
|
||||
impl/amg_smlprec_aply.f90
|
||||
impl/level/amg_s_base_onelev_map_rstr.F90
|
||||
impl/level/amg_c_base_onelev_csetr.f90
|
||||
impl/level/amg_d_base_onelev_map_rstr.F90
|
||||
impl/level/amg_z_base_onelev_setsv.F90
|
||||
impl/level/amg_d_base_onelev_descr.f90
|
||||
impl/level/amg_d_base_onelev_setag.f90
|
||||
impl/level/amg_s_base_onelev_dump.f90
|
||||
impl/level/amg_s_base_onelev_build.f90
|
||||
impl/level/amg_c_base_onelev_map_rstr.F90
|
||||
impl/level/amg_z_base_onelev_memory_use.f90
|
||||
impl/level/amg_s_base_onelev_map_prol.F90
|
||||
impl/level/amg_d_base_onelev_csetc.F90
|
||||
impl/level/amg_d_base_onelev_cnv.f90
|
||||
impl/level/amg_c_base_onelev_setsv.F90
|
||||
impl/level/amg_c_base_onelev_descr.f90
|
||||
impl/level/amg_z_base_onelev_setsm.F90
|
||||
impl/level/amg_d_base_onelev_csetr.f90
|
||||
impl/level/amg_s_base_onelev_descr.f90
|
||||
impl/level/amg_c_base_onelev_build.f90
|
||||
impl/level/amg_c_base_onelev_setag.f90
|
||||
impl/level/amg_c_base_onelev_free_smoothers.f90
|
||||
impl/level/amg_c_base_onelev_memory_use.f90
|
||||
impl/level/amg_s_base_onelev_csetr.f90
|
||||
impl/level/amg_s_base_onelev_mat_asb.f90
|
||||
impl/level/amg_c_base_onelev_free.f90
|
||||
impl/level/amg_d_base_onelev_free_smoothers.f90
|
||||
impl/level/amg_z_base_onelev_map_prol.F90
|
||||
impl/level/amg_s_base_onelev_free_smoothers.f90
|
||||
impl/level/amg_d_base_onelev_map_prol.F90
|
||||
impl/level/amg_d_base_onelev_free.f90
|
||||
impl/level/amg_z_base_onelev_cnv.f90
|
||||
impl/level/amg_s_base_onelev_cseti.F90
|
||||
impl/level/amg_s_base_onelev_csetc.F90
|
||||
impl/level/amg_c_base_onelev_map_prol.F90
|
||||
impl/level/amg_d_base_onelev_check.f90
|
||||
impl/level/amg_d_base_onelev_setsm.F90
|
||||
impl/level/amg_s_base_onelev_setsv.F90
|
||||
impl/level/amg_z_base_onelev_mat_asb.f90
|
||||
impl/level/amg_c_base_onelev_mat_asb.f90
|
||||
impl/level/amg_z_base_onelev_cseti.F90
|
||||
impl/level/amg_z_base_onelev_descr.f90
|
||||
impl/level/amg_z_base_onelev_map_rstr.F90
|
||||
impl/level/amg_z_base_onelev_check.f90
|
||||
impl/level/amg_c_base_onelev_cnv.f90
|
||||
impl/level/amg_z_base_onelev_build.f90
|
||||
impl/level/amg_d_base_onelev_build.f90
|
||||
impl/level/amg_c_base_onelev_cseti.F90
|
||||
impl/level/amg_c_base_onelev_check.f90
|
||||
impl/level/amg_s_base_onelev_check.f90
|
||||
impl/level/amg_s_base_onelev_memory_use.f90
|
||||
impl/level/amg_s_base_onelev_cnv.f90
|
||||
impl/level/amg_z_base_onelev_setag.f90
|
||||
impl/level/amg_s_base_onelev_free.f90
|
||||
impl/level/amg_z_base_onelev_dump.f90
|
||||
impl/level/amg_z_base_onelev_csetr.f90
|
||||
impl/level/amg_z_base_onelev_free_smoothers.f90
|
||||
impl/level/amg_c_base_onelev_csetc.F90
|
||||
impl/level/amg_d_base_onelev_dump.f90
|
||||
impl/level/amg_z_base_onelev_csetc.F90
|
||||
impl/level/amg_d_base_onelev_setsv.F90
|
||||
impl/level/amg_s_base_onelev_setsm.F90
|
||||
impl/level/amg_d_base_onelev_mat_asb.f90
|
||||
impl/level/amg_s_base_onelev_setag.f90
|
||||
impl/level/amg_d_base_onelev_cseti.F90
|
||||
impl/level/amg_d_base_onelev_memory_use.f90
|
||||
impl/level/amg_c_base_onelev_setsm.F90
|
||||
impl/level/amg_z_base_onelev_free.f90
|
||||
impl/level/amg_c_base_onelev_dump.f90
|
||||
impl/amg_z_hierarchy_bld.F90
|
||||
impl/amg_zfile_prec_memory_use.f90
|
||||
impl/amg_c_smoothers_bld.f90
|
||||
impl/amg_dmlprec_aply.f90
|
||||
impl/amg_cprecaply.f90
|
||||
impl/amg_zcprecset.F90
|
||||
impl/amg_z_smoothers_bld.f90
|
||||
impl/amg_cprecset.F90
|
||||
impl/amg_cfile_prec_memory_use.f90
|
||||
impl/amg_z_extprol_bld.F90
|
||||
impl/amg_sprecbld.f90
|
||||
impl/amg_s_hierarchy_rebld.f90
|
||||
impl/amg_s_smoothers_bld.f90
|
||||
impl/amg_dprecinit.F90
|
||||
impl/amg_zmlprec_bld.f90
|
||||
impl/amg_smlprec_bld.f90
|
||||
impl/amg_sfile_prec_memory_use.f90
|
||||
impl/amg_dprecaply.f90
|
||||
impl/amg_zprecbld.f90
|
||||
impl/amg_z_hierarchy_rebld.f90
|
||||
impl/amg_c_extprol_bld.F90
|
||||
impl/amg_zprecaply.f90
|
||||
impl/amg_s_extprol_bld.F90
|
||||
impl/amg_dfile_prec_memory_use.f90
|
||||
impl/solver/amg_z_invt_solver_clone_settings.f90
|
||||
impl/solver/amg_c_gs_solver_clear_data.f90
|
||||
impl/solver/amg_d_base_solver_apply.f90
|
||||
impl/solver/amg_s_ilu_solver_apply.f90
|
||||
impl/solver/amg_d_jac_solver_apply.f90
|
||||
impl/solver/amg_z_base_solver_csetr.f90
|
||||
impl/solver/amg_z_ilu_solver_dmp.f90
|
||||
impl/solver/amg_d_diag_solver_dmp.f90
|
||||
impl/solver/amg_c_invt_solver_check.f90
|
||||
impl/solver/amg_z_base_solver_descr.f90
|
||||
impl/solver/amg_d_mumps_solver_apply_vect.F90
|
||||
impl/solver/amg_d_l1_jac_solver_bld.f90
|
||||
impl/solver/amg_z_base_solver_cseti.f90
|
||||
impl/solver/amg_d_ainv_solver_check.f90
|
||||
impl/solver/amg_s_invt_solver_bld.f90
|
||||
impl/solver/amg_z_ainv_solver_clone_settings.f90
|
||||
impl/solver/amg_c_bwgs_solver_bld.f90
|
||||
impl/solver/amg_z_base_ainv_solver_apply_vect.f90
|
||||
impl/solver/amg_d_id_solver_apply.f90
|
||||
impl/solver/amg_s_base_solver_apply_vect.f90
|
||||
impl/solver/amg_s_base_solver_clone.f90
|
||||
impl/solver/amg_c_base_ainv_update_a.f90
|
||||
impl/solver/amg_s_id_solver_clone.f90
|
||||
impl/solver/amg_s_invk_solver_clone_settings.f90
|
||||
impl/solver/amg_z_ainv_solver_bld.f90
|
||||
impl/solver/amg_z_diag_solver_cnv.f90
|
||||
impl/solver/amg_d_mumps_solver_bld.F90
|
||||
impl/solver/amg_d_jac_solver_clear_data.f90
|
||||
impl/solver/amg_c_jac_solver_clone_settings.f90
|
||||
impl/solver/amg_z_gs_solver_clear_data.f90
|
||||
impl/solver/amg_c_ainv_solver_cseti.f90
|
||||
impl/solver/amg_z_base_solver_cnv.f90
|
||||
impl/solver/amg_s_bwgs_solver_bld.f90
|
||||
impl/solver/amg_s_id_solver_apply_vect.f90
|
||||
impl/solver/amg_z_jac_solver_clone.f90
|
||||
impl/solver/amg_z_ainv_solver_check.f90
|
||||
impl/solver/amg_d_ilu_solver_clear_data.f90
|
||||
impl/solver/amg_s_invk_solver_cseti.f90
|
||||
impl/solver/amg_s_ainv_solver_csetc.f90
|
||||
impl/solver/amg_z_base_ainv_solver_apply.f90
|
||||
impl/solver/amg_c_gs_solver_clone.f90
|
||||
impl/solver/amg_d_base_ainv_solver_apply.f90
|
||||
# impl/solver/amg_d_ainv_solver_setr.f90
|
||||
impl/solver/amg_d_invt_solver_clone.f90
|
||||
impl/solver/amg_d_gs_solver_apply_vect.f90
|
||||
impl/solver/amg_s_base_solver_dmp.f90
|
||||
impl/solver/amg_d_ainv_solver_descr.f90
|
||||
impl/solver/amg_d_jac_solver_clone_settings.f90
|
||||
impl/solver/amg_z_base_solver_check.f90
|
||||
impl/solver/amg_z_diag_solver_clone.f90
|
||||
impl/solver/amg_s_invk_solver_clone.f90
|
||||
# impl/solver/amg_d_ainv_solver_setc.f90
|
||||
impl/solver/amg_d_gs_solver_clear_data.f90
|
||||
impl/solver/amg_c_invt_solver_bld.f90
|
||||
impl/solver/amg_s_jac_solver_clear_data.f90
|
||||
impl/solver/amg_d_jac_solver_dmp.f90
|
||||
|
||||
impl/solver/amg_c_base_solver_dmp.f90
|
||||
impl/solver/amg_s_diag_solver_dmp.f90
|
||||
impl/solver/amg_d_invt_solver_check.f90
|
||||
impl/solver/amg_c_ilu_solver_clear_data.f90
|
||||
impl/solver/amg_z_invt_solver_descr.f90
|
||||
impl/solver/amg_d_diag_solver_clone.f90
|
||||
impl/solver/amg_s_jac_solver_bld.f90
|
||||
impl/solver/amg_s_mumps_solver_apply.F90
|
||||
impl/solver/amg_z_jac_solver_clone_settings.f90
|
||||
# impl/solver/amg_d_invt_solver_seti.f90
|
||||
impl/solver/amg_s_base_ainv_solver_apply_vect.f90
|
||||
impl/solver/amg_z_diag_solver_apply.f90
|
||||
impl/solver/amg_s_base_solver_free.f90
|
||||
impl/solver/amg_d_ainv_solver_clone.f90
|
||||
impl/solver/amg_s_krm_solver_impl.f90
|
||||
# impl/solver/amg_d_ainv_solver_seti.f90
|
||||
impl/solver/amg_z_ainv_solver_clone.f90
|
||||
impl/solver/amg_d_base_ainv_solver_free.f90
|
||||
# impl/solver/amg_c_invk_solver_seti.f90
|
||||
impl/solver/amg_s_ilu_solver_dmp.f90
|
||||
impl/solver/amg_z_base_solver_apply.f90
|
||||
impl/solver/amg_d_ilu_solver_apply_vect.f90
|
||||
impl/solver/amg_z_jac_solver_dmp.f90
|
||||
impl/solver/amg_c_base_ainv_solver_cnv.f90
|
||||
impl/solver/amg_s_gs_solver_cnv.f90
|
||||
impl/solver/amg_s_id_solver_apply.f90
|
||||
impl/solver/amg_d_jac_solver_apply_vect.f90
|
||||
impl/solver/amg_s_base_solver_bld.f90
|
||||
impl/solver/amg_z_base_solver_csetc.f90
|
||||
impl/solver/amg_d_gs_solver_cnv.f90
|
||||
impl/solver/amg_d_bwgs_solver_apply.f90
|
||||
impl/solver/amg_c_diag_solver_dmp.f90
|
||||
impl/solver/amg_d_ilu_solver_dmp.f90
|
||||
impl/solver/amg_s_base_solver_check.f90
|
||||
impl/solver/amg_c_invk_solver_clone.f90
|
||||
impl/solver/amg_d_invk_solver_check.f90
|
||||
impl/solver/amg_z_ilu_solver_clone.f90
|
||||
impl/solver/amg_d_base_solver_cseti.f90
|
||||
impl/solver/amg_c_base_solver_bld.f90
|
||||
impl/solver/amg_z_jac_solver_apply_vect.f90
|
||||
impl/solver/amg_z_id_solver_apply.f90
|
||||
impl/solver/amg_d_base_solver_bld.f90
|
||||
# impl/solver/amg_s_ainv_solver_seti.f90
|
||||
impl/solver/amg_z_jac_solver_bld.f90
|
||||
impl/solver/amg_z_base_solver_apply_vect.f90
|
||||
impl/solver/amg_d_base_solver_clone.f90
|
||||
impl/solver/amg_d_ainv_solver_csetr.f90
|
||||
impl/solver/amg_s_invt_solver_cseti.f90
|
||||
impl/solver/amg_c_id_solver_apply_vect.f90
|
||||
impl/solver/amg_s_mumps_solver_apply_vect.F90
|
||||
impl/solver/amg_z_ilu_solver_apply.f90
|
||||
impl/solver/amg_c_diag_solver_apply_vect.f90
|
||||
impl/solver/amg_s_gs_solver_dmp.f90
|
||||
impl/solver/amg_z_base_ainv_solver_dmp.f90
|
||||
impl/solver/amg_c_diag_solver_cnv.f90
|
||||
# impl/solver/amg_z_invt_solver_setr.f90
|
||||
impl/solver/amg_z_diag_solver_apply_vect.f90
|
||||
impl/solver/amg_d_ainv_solver_cseti.f90
|
||||
impl/solver/amg_z_ilu_solver_clear_data.f90
|
||||
impl/solver/amg_d_base_solver_csetc.f90
|
||||
impl/solver/amg_c_invk_solver_descr.f90
|
||||
impl/solver/amg_d_invt_solver_csetr.f90
|
||||
impl/solver/amg_d_invt_solver_cseti.f90
|
||||
impl/solver/amg_z_invk_solver_bld.f90
|
||||
impl/solver/amg_s_jac_solver_clone.f90
|
||||
impl/solver/amg_d_bwgs_solver_bld.f90
|
||||
impl/solver/amg_z_diag_solver_bld.f90
|
||||
impl/solver/amg_s_l1_jac_solver_bld.f90
|
||||
impl/solver/amg_s_invt_solver_descr.f90
|
||||
impl/solver/amg_s_ilu_solver_bld.f90
|
||||
impl/solver/amg_c_gs_solver_clone_settings.f90
|
||||
impl/solver/amg_c_jac_solver_bld.f90
|
||||
impl/solver/amg_d_gs_solver_clone_settings.f90
|
||||
impl/solver/amg_d_base_solver_descr.f90
|
||||
impl/solver/amg_d_base_solver_dmp.f90
|
||||
impl/solver/amg_c_ainv_solver_bld.f90
|
||||
impl/solver/amg_s_invt_solver_check.f90
|
||||
impl/solver/amg_z_gs_solver_apply_vect.f90
|
||||
impl/solver/amg_z_ainv_solver_descr.f90
|
||||
# impl/solver/amg_c_invt_solver_seti.f90
|
||||
impl/solver/amg_c_base_solver_apply.f90
|
||||
impl/solver/amg_z_gs_solver_dmp.f90
|
||||
impl/solver/amg_d_ainv_solver_clone_settings.f90
|
||||
impl/solver/amg_c_id_solver_apply.f90
|
||||
impl/solver/amg_z_base_solver_clone.f90
|
||||
impl/solver/amg_s_invk_solver_check.f90
|
||||
impl/solver/amg_c_gs_solver_bld.f90
|
||||
impl/solver/amg_s_ilu_solver_cnv.f90
|
||||
impl/solver/amg_z_ainv_solver_csetc.f90
|
||||
impl/solver/amg_s_ainv_solver_clone_settings.f90
|
||||
impl/solver/amg_c_base_ainv_solver_apply_vect.f90
|
||||
impl/solver/amg_s_diag_solver_apply.f90
|
||||
impl/solver/amg_s_base_ainv_update_a.f90
|
||||
impl/solver/amg_c_base_solver_csetc.f90
|
||||
impl/solver/amg_c_jac_solver_clone.f90
|
||||
impl/solver/amg_c_base_solver_descr.f90
|
||||
impl/solver/amg_c_invt_solver_clone.f90
|
||||
impl/solver/amg_c_ilu_solver_bld.f90
|
||||
impl/solver/amg_d_base_ainv_solver_apply_vect.f90
|
||||
impl/solver/amg_d_base_solver_apply_vect.f90
|
||||
impl/solver/amg_z_invt_solver_check.f90
|
||||
impl/solver/amg_c_base_solver_cseti.f90
|
||||
impl/solver/amg_s_jac_solver_dmp.f90
|
||||
# impl/solver/amg_s_invk_solver_seti.f90
|
||||
impl/solver/amg_s_ainv_solver_check.f90
|
||||
impl/solver/amg_d_base_solver_clear_data.f90
|
||||
impl/solver/amg_z_gs_solver_clone_settings.f90
|
||||
impl/solver/amg_c_invk_solver_check.f90
|
||||
impl/solver/amg_s_base_solver_cseti.f90
|
||||
impl/solver/amg_z_base_ainv_solver_free.f90
|
||||
impl/solver/amg_z_invk_solver_clone_settings.f90
|
||||
impl/solver/amg_c_base_ainv_solver_dmp.f90
|
||||
impl/solver/amg_s_gs_solver_clear_data.f90
|
||||
impl/solver/amg_s_base_ainv_solver_apply.f90
|
||||
impl/solver/amg_c_base_solver_apply_vect.f90
|
||||
impl/solver/amg_d_diag_solver_cnv.f90
|
||||
impl/solver/amg_d_id_solver_apply_vect.f90
|
||||
impl/solver/amg_z_base_solver_bld.f90
|
||||
impl/solver/amg_z_base_solver_dmp.f90
|
||||
impl/solver/amg_d_invt_solver_clone_settings.f90
|
||||
impl/solver/amg_c_diag_solver_clone.f90
|
||||
impl/solver/amg_z_gs_solver_apply.f90
|
||||
impl/solver/amg_c_invt_solver_clone_settings.f90
|
||||
impl/solver/amg_z_base_solver_free.f90
|
||||
impl/solver/amg_d_diag_solver_clear_data.f90
|
||||
impl/solver/amg_d_ilu_solver_clone_settings.f90
|
||||
# impl/solver/amg_z_invt_solver_seti.f90
|
||||
# impl/solver/amg_z_ainv_solver_seti.f90
|
||||
impl/solver/amg_c_diag_solver_apply.f90
|
||||
impl/solver/amg_d_base_ainv_solver_dmp.f90
|
||||
impl/solver/amg_c_invt_solver_csetr.f90
|
||||
# impl/solver/amg_c_invt_solver_setr.f90
|
||||
impl/solver/amg_c_jac_solver_clear_data.f90
|
||||
impl/solver/amg_c_invk_solver_bld.f90
|
||||
impl/solver/amg_c_ainv_solver_csetc.f90
|
||||
impl/solver/amg_s_ainv_solver_cseti.f90
|
||||
impl/solver/amg_z_base_solver_clear_data.f90
|
||||
impl/solver/amg_z_invk_solver_check.f90
|
||||
impl/solver/amg_c_diag_solver_bld.f90
|
||||
impl/solver/amg_d_invk_solver_clone_settings.f90
|
||||
impl/solver/amg_s_ainv_solver_clone.f90
|
||||
impl/solver/amg_s_diag_solver_clear_data.f90
|
||||
impl/solver/amg_d_gs_solver_clone.f90
|
||||
impl/solver/amg_s_base_solver_csetr.f90
|
||||
impl/solver/amg_c_ilu_solver_dmp.f90
|
||||
impl/solver/amg_c_base_solver_cnv.f90
|
||||
# impl/solver/amg_z_ainv_solver_setc.f90
|
||||
impl/solver/amg_z_jac_solver_apply.f90
|
||||
impl/solver/amg_s_ainv_solver_descr.f90
|
||||
impl/solver/amg_z_base_ainv_solver_cnv.f90
|
||||
impl/solver/amg_c_ilu_solver_apply.f90
|
||||
impl/solver/amg_c_ilu_solver_cnv.f90
|
||||
impl/solver/amg_z_bwgs_solver_bld.f90
|
||||
impl/solver/amg_c_base_ainv_solver_free.f90
|
||||
impl/solver/amg_s_base_solver_clone_settings.f90
|
||||
impl/solver/amg_z_invt_solver_bld.f90
|
||||
impl/solver/amg_s_base_ainv_solver_free.f90
|
||||
impl/solver/amg_s_base_solver_clear_data.f90
|
||||
impl/solver/amg_s_invt_solver_csetr.f90
|
||||
impl/solver/amg_d_diag_solver_apply_vect.f90
|
||||
impl/solver/amg_s_diag_solver_bld.f90
|
||||
impl/solver/amg_s_diag_solver_cnv.f90
|
||||
impl/solver/amg_d_diag_solver_apply.f90
|
||||
impl/solver/amg_d_invk_solver_descr.f90
|
||||
impl/solver/amg_z_mumps_solver_apply.F90
|
||||
impl/solver/amg_s_base_solver_descr.f90
|
||||
impl/solver/amg_c_jac_solver_apply_vect.f90
|
||||
impl/solver/amg_s_base_ainv_solver_dmp.f90
|
||||
impl/solver/amg_z_krm_solver_impl.f90
|
||||
impl/solver/amg_z_invt_solver_csetr.f90
|
||||
impl/solver/amg_c_ainv_solver_check.f90
|
||||
# impl/solver/amg_s_invt_solver_seti.f90
|
||||
impl/solver/amg_z_ainv_solver_cseti.f90
|
||||
impl/solver/amg_z_invk_solver_clone.f90
|
||||
impl/solver/amg_s_base_solver_csetc.f90
|
||||
impl/solver/amg_z_bwgs_solver_apply_vect.f90
|
||||
impl/solver/amg_c_bwgs_solver_apply.f90
|
||||
impl/solver/amg_c_base_solver_csetr.f90
|
||||
impl/solver/amg_c_invk_solver_cseti.f90
|
||||
impl/solver/amg_d_krm_solver_impl.f90
|
||||
impl/solver/amg_s_invk_solver_bld.f90
|
||||
impl/solver/amg_c_mumps_solver_apply.F90
|
||||
impl/solver/amg_z_jac_solver_cnv.f90
|
||||
# impl/solver/amg_s_ainv_solver_setr.f90
|
||||
impl/solver/amg_d_gs_solver_bld.f90
|
||||
impl/solver/amg_c_ilu_solver_clone_settings.f90
|
||||
impl/solver/amg_z_base_solver_clone_settings.f90
|
||||
impl/solver/amg_d_ilu_solver_clone.f90
|
||||
impl/solver/amg_c_ilu_solver_clone.f90
|
||||
impl/solver/amg_d_ainv_solver_bld.f90
|
||||
impl/solver/amg_c_gs_solver_apply.f90
|
||||
impl/solver/amg_z_mumps_solver_apply_vect.F90
|
||||
impl/solver/amg_c_ainv_solver_clone.f90
|
||||
impl/solver/amg_c_base_solver_clear_data.f90
|
||||
impl/solver/amg_z_diag_solver_dmp.f90
|
||||
impl/solver/amg_z_id_solver_apply_vect.f90
|
||||
impl/solver/amg_d_ilu_solver_bld.f90
|
||||
impl/solver/amg_s_base_solver_apply.f90
|
||||
impl/solver/amg_s_ainv_solver_csetr.f90
|
||||
impl/solver/amg_z_ilu_solver_cnv.f90
|
||||
impl/solver/amg_s_invk_solver_descr.f90
|
||||
impl/solver/amg_d_jac_solver_bld.f90
|
||||
impl/solver/amg_z_invk_solver_cseti.f90
|
||||
impl/solver/amg_z_id_solver_clone.f90
|
||||
impl/solver/amg_d_id_solver_clone.f90
|
||||
impl/solver/amg_z_diag_solver_clear_data.f90
|
||||
impl/solver/amg_s_gs_solver_bld.f90
|
||||
impl/solver/amg_s_bwgs_solver_apply.f90
|
||||
impl/solver/amg_s_gs_solver_clone.f90
|
||||
impl/solver/amg_s_jac_solver_apply.f90
|
||||
impl/solver/amg_z_ilu_solver_clone_settings.f90
|
||||
impl/solver/amg_c_mumps_solver_bld.F90
|
||||
impl/solver/amg_d_mumps_solver_apply.F90
|
||||
# impl/solver/amg_s_ainv_solver_setc.f90
|
||||
impl/solver/amg_d_base_solver_cnv.f90
|
||||
impl/solver/amg_s_ilu_solver_clear_data.f90
|
||||
impl/solver/amg_d_bwgs_solver_apply_vect.f90
|
||||
impl/solver/amg_s_jac_solver_apply_vect.f90
|
||||
impl/solver/amg_c_invk_solver_clone_settings.f90
|
||||
impl/solver/amg_c_base_solver_clone_settings.f90
|
||||
impl/solver/amg_z_gs_solver_cnv.f90
|
||||
impl/solver/amg_s_invt_solver_clone.f90
|
||||
# impl/solver/amg_z_invk_solver_seti.f90
|
||||
impl/solver/amg_c_ainv_solver_csetr.f90
|
||||
impl/solver/amg_c_jac_solver_apply.f90
|
||||
impl/solver/amg_c_gs_solver_dmp.f90
|
||||
impl/solver/amg_z_ilu_solver_bld.f90
|
||||
impl/solver/amg_c_invt_solver_descr.f90
|
||||
impl/solver/amg_z_invt_solver_clone.f90
|
||||
impl/solver/amg_d_base_ainv_update_a.f90
|
||||
impl/solver/amg_c_base_solver_clone.f90
|
||||
impl/solver/amg_s_diag_solver_clone.f90
|
||||
impl/solver/amg_d_invt_solver_bld.f90
|
||||
# impl/solver/amg_c_ainv_solver_setc.f90
|
||||
impl/solver/amg_d_gs_solver_dmp.f90
|
||||
impl/solver/amg_s_gs_solver_apply.f90
|
||||
impl/solver/amg_d_jac_solver_clone.f90
|
||||
impl/solver/amg_z_jac_solver_clear_data.f90
|
||||
impl/solver/amg_c_invt_solver_cseti.f90
|
||||
impl/solver/amg_d_ilu_solver_apply.f90
|
||||
# impl/solver/amg_c_ainv_solver_setr.f90
|
||||
impl/solver/amg_c_gs_solver_cnv.f90
|
||||
impl/solver/amg_c_diag_solver_clear_data.f90
|
||||
impl/solver/amg_c_base_solver_check.f90
|
||||
impl/solver/amg_c_base_solver_free.f90
|
||||
impl/solver/amg_z_invt_solver_cseti.f90
|
||||
impl/solver/amg_d_base_solver_check.f90
|
||||
impl/solver/amg_d_invk_solver_clone.f90
|
||||
impl/solver/amg_c_krm_solver_impl.f90
|
||||
impl/solver/amg_d_base_ainv_solver_cnv.f90
|
||||
impl/solver/amg_d_invk_solver_cseti.f90
|
||||
impl/solver/amg_z_mumps_solver_bld.F90
|
||||
impl/solver/amg_z_gs_solver_bld.f90
|
||||
# impl/solver/amg_z_ainv_solver_setr.f90
|
||||
impl/solver/amg_s_gs_solver_apply_vect.f90
|
||||
impl/solver/amg_s_jac_solver_clone_settings.f90
|
||||
impl/solver/amg_z_gs_solver_clone.f90
|
||||
impl/solver/amg_c_gs_solver_apply_vect.f90
|
||||
impl/solver/amg_d_base_solver_csetr.f90
|
||||
impl/solver/amg_s_ainv_solver_bld.f90
|
||||
impl/solver/amg_z_l1_jac_solver_bld.f90
|
||||
impl/solver/amg_z_base_ainv_update_a.f90
|
||||
impl/solver/amg_z_ainv_solver_csetr.f90
|
||||
impl/solver/amg_s_ilu_solver_apply_vect.f90
|
||||
# impl/solver/amg_s_invt_solver_setr.f90
|
||||
# impl/solver/amg_d_invt_solver_setr.f90
|
||||
impl/solver/amg_d_invk_solver_bld.f90
|
||||
impl/solver/amg_s_jac_solver_cnv.f90
|
||||
impl/solver/amg_z_bwgs_solver_apply.f90
|
||||
impl/solver/amg_s_bwgs_solver_apply_vect.f90
|
||||
# impl/solver/amg_d_invk_solver_seti.f90
|
||||
impl/solver/amg_d_ilu_solver_cnv.f90
|
||||
impl/solver/amg_s_mumps_solver_bld.F90
|
||||
impl/solver/amg_s_gs_solver_clone_settings.f90
|
||||
impl/solver/amg_c_jac_solver_dmp.f90
|
||||
impl/solver/amg_d_jac_solver_cnv.f90
|
||||
impl/solver/amg_c_ilu_solver_apply_vect.f90
|
||||
impl/solver/amg_c_mumps_solver_apply_vect.F90
|
||||
impl/solver/amg_z_ilu_solver_apply_vect.f90
|
||||
impl/solver/amg_s_ilu_solver_clone_settings.f90
|
||||
impl/solver/amg_c_ainv_solver_clone_settings.f90
|
||||
# impl/solver/amg_c_ainv_solver_seti.f90
|
||||
impl/solver/amg_s_ilu_solver_clone.f90
|
||||
impl/solver/amg_d_diag_solver_bld.f90
|
||||
impl/solver/amg_c_l1_jac_solver_bld.f90
|
||||
impl/solver/amg_c_bwgs_solver_apply_vect.f90
|
||||
impl/solver/amg_c_jac_solver_cnv.f90
|
||||
impl/solver/amg_c_id_solver_clone.f90
|
||||
impl/solver/amg_d_gs_solver_apply.f90
|
||||
impl/solver/amg_z_invk_solver_descr.f90
|
||||
impl/solver/amg_s_diag_solver_apply_vect.f90
|
||||
impl/solver/amg_s_base_solver_cnv.f90
|
||||
impl/solver/amg_d_base_solver_clone_settings.f90
|
||||
impl/solver/amg_s_invt_solver_clone_settings.f90
|
||||
impl/solver/amg_d_ainv_solver_csetc.f90
|
||||
impl/solver/amg_d_invt_solver_descr.f90
|
||||
impl/solver/amg_d_base_solver_free.f90
|
||||
impl/solver/amg_c_base_ainv_solver_apply.f90
|
||||
impl/solver/amg_s_base_ainv_solver_cnv.f90
|
||||
impl/solver/amg_c_ainv_solver_descr.f90
|
||||
impl/amg_sfile_prec_descr.f90
|
||||
impl/amg_zprecinit.F90
|
||||
impl/amg_dprecbld.f90
|
||||
impl/amg_sprecaply.f90
|
||||
impl/amg_cprecbld.f90
|
||||
impl/amg_cfile_prec_descr.f90
|
||||
impl/amg_s_hierarchy_bld.F90
|
||||
impl/amg_dfile_prec_descr.f90
|
||||
impl/amg_ccprecset.F90
|
||||
impl/amg_d_hierarchy_bld.F90
|
||||
impl/amg_c_hierarchy_bld.F90
|
||||
impl/smoother/amg_d_base_smoother_clone_settings.f90
|
||||
impl/smoother/amg_d_as_smoother_check.f90
|
||||
impl/smoother/amg_c_l1_jac_smoother_clone.f90
|
||||
impl/smoother/amg_z_l1_jac_smoother_bld.f90
|
||||
impl/smoother/amg_s_poly_smoother_clear_data.f90
|
||||
impl/smoother/amg_s_poly_smoother_apply_vect.f90
|
||||
impl/smoother/amg_z_jac_smoother_clone_settings.f90
|
||||
impl/smoother/amg_s_poly_smoother_csetc.f90
|
||||
impl/smoother/amg_s_as_smoother_prol_a.f90
|
||||
impl/smoother/amg_s_base_smoother_csetc.f90
|
||||
impl/smoother/amg_s_as_smoother_apply.f90
|
||||
impl/smoother/amg_z_base_smoother_csetr.f90
|
||||
impl/smoother/amg_c_jac_smoother_apply.f90
|
||||
impl/smoother/amg_s_base_smoother_clone.f90
|
||||
impl/smoother/amg_d_jac_smoother_dmp.f90
|
||||
impl/smoother/amg_z_base_smoother_cnv.f90
|
||||
impl/smoother/amg_s_jac_smoother_apply.f90
|
||||
impl/smoother/amg_z_jac_smoother_bld.f90
|
||||
impl/smoother/amg_c_as_smoother_clone.f90
|
||||
impl/smoother/amg_d_as_smoother_apply_vect.f90
|
||||
impl/smoother/amg_d_poly_smoother_descr.f90
|
||||
impl/smoother/amg_s_as_smoother_csetc.f90
|
||||
impl/smoother/amg_z_base_smoother_cseti.f90
|
||||
impl/smoother/amg_s_base_smoother_cseti.f90
|
||||
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_c_as_smoother_clear_data.f90
|
||||
impl/smoother/amg_s_poly_smoother_descr.f90
|
||||
impl/smoother/amg_z_as_smoother_cseti.f90
|
||||
impl/smoother/amg_s_as_smoother_apply_vect.f90
|
||||
impl/smoother/amg_c_jac_smoother_csetr.f90
|
||||
impl/smoother/amg_d_base_smoother_free.f90
|
||||
impl/smoother/amg_z_as_smoother_bld.f90
|
||||
impl/smoother/amg_s_base_smoother_clear_data.f90
|
||||
impl/smoother/amg_c_jac_smoother_bld.f90
|
||||
impl/smoother/amg_d_as_smoother_restr_v.f90
|
||||
impl/smoother/amg_c_as_smoother_check.f90
|
||||
impl/smoother/amg_d_poly_smoother_cseti.f90
|
||||
impl/smoother/amg_d_as_smoother_clone.f90
|
||||
impl/smoother/amg_z_as_smoother_clear_data.f90
|
||||
impl/smoother/amg_d_as_smoother_free.f90
|
||||
impl/smoother/amg_s_as_smoother_cnv.f90
|
||||
impl/smoother/amg_s_base_smoother_dmp.f90
|
||||
impl/smoother/amg_d_l1_jac_smoother_descr.f90
|
||||
impl/smoother/amg_s_poly_smoother_cnv.f90
|
||||
impl/smoother/amg_d_jac_smoother_csetr.f90
|
||||
impl/smoother/amg_d_base_smoother_apply.f90
|
||||
impl/smoother/amg_s_as_smoother_cseti.f90
|
||||
impl/smoother/amg_s_base_smoother_apply_vect.f90
|
||||
impl/smoother/amg_c_base_smoother_cseti.f90
|
||||
impl/smoother/amg_c_as_smoother_cnv.f90
|
||||
impl/smoother/amg_z_jac_smoother_cnv.f90
|
||||
impl/smoother/amg_s_poly_smoother_bld.f90
|
||||
impl/smoother/amg_d_jac_smoother_cseti.f90
|
||||
impl/smoother/amg_s_as_smoother_prol_v.f90
|
||||
impl/smoother/amg_c_as_smoother_restr_a.f90
|
||||
impl/smoother/amg_d_base_smoother_bld.f90
|
||||
impl/smoother/amg_c_jac_smoother_clone.f90
|
||||
impl/smoother/amg_d_jac_smoother_bld.f90
|
||||
impl/smoother/amg_z_jac_smoother_apply_vect.f90
|
||||
impl/smoother/amg_c_as_smoother_prol_v.f90
|
||||
impl/smoother/amg_z_jac_smoother_csetc.f90
|
||||
impl/smoother/amg_z_as_smoother_prol_v.f90
|
||||
impl/smoother/amg_d_base_smoother_cnv.f90
|
||||
impl/smoother/amg_c_l1_jac_smoother_bld.f90
|
||||
impl/smoother/amg_z_as_smoother_apply_vect.f90
|
||||
impl/smoother/amg_s_as_smoother_restr_v.f90
|
||||
impl/smoother/amg_d_l1_jac_smoother_bld.f90
|
||||
impl/smoother/amg_s_jac_smoother_bld.f90
|
||||
impl/smoother/amg_s_poly_smoother_clone_settings.f90
|
||||
impl/smoother/amg_d_base_smoother_check.f90
|
||||
impl/smoother/amg_z_base_smoother_bld.f90
|
||||
impl/smoother/amg_s_l1_jac_smoother_clone.f90
|
||||
impl/smoother/amg_c_jac_smoother_clone_settings.f90
|
||||
impl/smoother/amg_s_poly_smoother_dmp.f90
|
||||
impl/smoother/amg_c_base_smoother_csetr.f90
|
||||
impl/smoother/amg_d_poly_smoother_clone_settings.f90
|
||||
impl/smoother/amg_z_as_smoother_clone_settings.f90
|
||||
impl/smoother/amg_z_jac_smoother_csetr.f90
|
||||
impl/smoother/amg_d_jac_smoother_csetc.f90
|
||||
impl/smoother/amg_z_base_smoother_dmp.f90
|
||||
impl/smoother/amg_s_jac_smoother_csetr.f90
|
||||
impl/smoother/amg_s_base_smoother_bld.f90
|
||||
impl/smoother/amg_z_jac_smoother_descr.f90
|
||||
impl/smoother/amg_z_jac_smoother_cseti.f90
|
||||
impl/smoother/amg_d_as_smoother_dmp.f90
|
||||
impl/smoother/amg_d_jac_smoother_apply.f90
|
||||
impl/smoother/amg_c_jac_smoother_dmp.f90
|
||||
impl/smoother/amg_z_as_smoother_apply.f90
|
||||
impl/smoother/amg_z_as_smoother_check.f90
|
||||
impl/smoother/amg_z_jac_smoother_clear_data.f90
|
||||
impl/smoother/amg_s_base_smoother_descr.f90
|
||||
impl/smoother/amg_s_jac_smoother_clone.f90
|
||||
impl/smoother/amg_z_jac_smoother_clone.f90
|
||||
impl/smoother/amg_c_as_smoother_clone_settings.f90
|
||||
impl/smoother/amg_c_base_smoother_check.f90
|
||||
impl/smoother/amg_d_poly_smoother_apply_vect.f90
|
||||
impl/smoother/amg_s_l1_jac_smoother_bld.f90
|
||||
impl/smoother/amg_c_as_smoother_apply_vect.f90
|
||||
impl/smoother/amg_z_as_smoother_cnv.f90
|
||||
impl/smoother/amg_z_as_smoother_csetc.f90
|
||||
impl/smoother/amg_d_as_smoother_csetc.f90
|
||||
impl/smoother/amg_d_jac_smoother_cnv.f90
|
||||
impl/smoother/amg_c_as_smoother_csetc.f90
|
||||
impl/smoother/amg_z_base_smoother_clone_settings.f90
|
||||
impl/smoother/amg_s_as_smoother_free.f90
|
||||
impl/smoother/amg_z_base_smoother_free.f90
|
||||
impl/smoother/amg_c_base_smoother_apply.f90
|
||||
impl/smoother/amg_z_l1_jac_smoother_descr.f90
|
||||
impl/smoother/amg_s_as_smoother_clone_settings.f90
|
||||
impl/smoother/amg_d_base_smoother_csetr.f90
|
||||
impl/smoother/amg_c_jac_smoother_clear_data.f90
|
||||
impl/smoother/amg_d_poly_smoother_bld.f90
|
||||
impl/smoother/amg_z_base_smoother_csetc.f90
|
||||
impl/smoother/amg_z_base_smoother_clone.f90
|
||||
impl/smoother/amg_s_jac_smoother_apply_vect.f90
|
||||
impl/smoother/amg_z_base_smoother_clear_data.f90
|
||||
impl/smoother/amg_c_base_smoother_clone_settings.f90
|
||||
impl/smoother/amg_d_base_smoother_clone.f90
|
||||
impl/smoother/amg_d_base_smoother_cseti.f90
|
||||
impl/smoother/amg_z_l1_jac_smoother_clone.f90
|
||||
impl/smoother/amg_s_l1_jac_smoother_descr.f90
|
||||
impl/smoother/amg_c_jac_smoother_descr.f90
|
||||
impl/smoother/amg_z_base_smoother_check.f90
|
||||
impl/smoother/amg_d_jac_smoother_clear_data.f90
|
||||
impl/smoother/amg_d_as_smoother_prol_a.f90
|
||||
impl/smoother/amg_c_as_smoother_apply.f90
|
||||
impl/smoother/amg_c_base_smoother_cnv.f90
|
||||
impl/smoother/amg_c_jac_smoother_cnv.f90
|
||||
impl/smoother/amg_c_base_smoother_csetc.f90
|
||||
impl/smoother/amg_d_base_smoother_csetc.f90
|
||||
impl/smoother/amg_d_poly_smoother_csetr.f90
|
||||
impl/smoother/amg_c_jac_smoother_cseti.f90
|
||||
impl/smoother/amg_s_base_smoother_cnv.f90
|
||||
impl/smoother/amg_s_poly_smoother_csetr.f90
|
||||
impl/smoother/amg_s_base_smoother_clone_settings.f90
|
||||
impl/smoother/amg_s_as_smoother_restr_a.f90
|
||||
impl/smoother/amg_d_base_smoother_dmp.f90
|
||||
impl/smoother/amg_d_jac_smoother_descr.f90
|
||||
impl/smoother/amg_c_base_smoother_free.f90
|
||||
impl/smoother/amg_c_as_smoother_free.f90
|
||||
impl/smoother/amg_s_jac_smoother_clear_data.f90
|
||||
impl/smoother/amg_s_jac_smoother_cseti.f90
|
||||
impl/smoother/amg_d_poly_smoother_clone.f90
|
||||
impl/smoother/amg_s_jac_smoother_csetc.f90
|
||||
impl/smoother/amg_s_as_smoother_dmp.f90
|
||||
impl/smoother/amg_s_base_smoother_apply.f90
|
||||
impl/smoother/amg_s_as_smoother_clone.f90
|
||||
impl/smoother/amg_c_l1_jac_smoother_descr.f90
|
||||
impl/smoother/amg_s_jac_smoother_cnv.f90
|
||||
impl/smoother/amg_z_as_smoother_free.f90
|
||||
impl/smoother/amg_s_poly_smoother_clone.f90
|
||||
impl/smoother/amg_s_as_smoother_clear_data.f90
|
||||
impl/smoother/amg_s_jac_smoother_dmp.f90
|
||||
impl/smoother/amg_c_base_smoother_clone.f90
|
||||
impl/smoother/amg_d_poly_smoother_csetc.f90
|
||||
impl/smoother/amg_d_as_smoother_cseti.f90
|
||||
impl/smoother/amg_z_base_smoother_descr.f90
|
||||
impl/smoother/amg_d_as_smoother_restr_a.f90
|
||||
impl/smoother/amg_s_base_smoother_check.f90
|
||||
impl/smoother/amg_c_as_smoother_restr_v.f90
|
||||
impl/smoother/amg_d_poly_smoother_cnv.f90
|
||||
impl/smoother/amg_c_jac_smoother_csetc.f90
|
||||
impl/smoother/amg_z_jac_smoother_dmp.f90
|
||||
impl/smoother/amg_z_base_smoother_apply.f90
|
||||
impl/smoother/amg_s_base_smoother_csetr.f90
|
||||
impl/smoother/amg_d_as_smoother_apply.f90
|
||||
impl/smoother/amg_c_as_smoother_prol_a.f90
|
||||
impl/smoother/amg_d_poly_smoother_clear_data.f90
|
||||
impl/smoother/amg_c_base_smoother_descr.f90
|
||||
impl/smoother/amg_d_as_smoother_bld.f90
|
||||
impl/smoother/amg_c_as_smoother_bld.f90
|
||||
impl/smoother/amg_c_as_smoother_cseti.f90
|
||||
impl/smoother/amg_s_as_smoother_bld.f90
|
||||
impl/smoother/amg_z_as_smoother_restr_a.f90
|
||||
impl/smoother/amg_d_as_smoother_clear_data.f90
|
||||
impl/smoother/amg_d_l1_jac_smoother_clone.f90
|
||||
impl/smoother/amg_c_base_smoother_dmp.f90
|
||||
impl/smoother/amg_d_base_smoother_descr.f90
|
||||
impl/smoother/amg_c_base_smoother_apply_vect.f90
|
||||
impl/smoother/amg_d_base_smoother_apply_vect.f90
|
||||
impl/smoother/amg_c_base_smoother_clear_data.f90
|
||||
impl/smoother/amg_d_poly_smoother_dmp.f90
|
||||
impl/smoother/amg_s_poly_smoother_cseti.f90
|
||||
impl/smoother/amg_s_as_smoother_check.f90
|
||||
impl/smoother/amg_s_jac_smoother_descr.f90
|
||||
impl/smoother/amg_d_jac_smoother_clone_settings.f90
|
||||
impl/smoother/amg_d_as_smoother_prol_v.f90
|
||||
impl/smoother/amg_z_jac_smoother_apply.f90
|
||||
impl/smoother/amg_d_as_smoother_cnv.f90
|
||||
impl/smoother/amg_c_jac_smoother_apply_vect.f90
|
||||
impl/smoother/amg_c_as_smoother_dmp.f90
|
||||
impl/smoother/amg_c_base_smoother_bld.f90
|
||||
impl/smoother/amg_d_as_smoother_clone_settings.f90
|
||||
impl/smoother/amg_d_base_smoother_clear_data.f90
|
||||
impl/smoother/amg_s_jac_smoother_clone_settings.f90
|
||||
impl/smoother/amg_z_as_smoother_dmp.f90
|
||||
impl/smoother/amg_z_as_smoother_clone.f90
|
||||
impl/smoother/amg_z_as_smoother_restr_v.f90
|
||||
impl/smoother/amg_z_as_smoother_prol_a.f90
|
||||
impl/smoother/amg_z_base_smoother_apply_vect.f90
|
||||
impl/amg_d_smoothers_bld.f90
|
||||
impl/amg_zprecset.F90
|
||||
impl/amg_d_hierarchy_rebld.f90
|
||||
impl/amg_d_extprol_bld.F90
|
||||
impl/amg_dprecset.F90
|
||||
impl/amg_scprecset.F90
|
||||
impl/amg_sprecset.F90
|
||||
impl/amg_dmlprec_bld.f90
|
||||
impl/amg_zmlprec_aply.f90
|
||||
impl/aggregator/amg_d_dec_aggregator_tprol.f90
|
||||
impl/aggregator/amg_s_parmatch_aggregator_mat_asb.F90
|
||||
impl/aggregator/amg_s_parmatch_aggregator_tprol.F90
|
||||
impl/aggregator/amg_z_dec_aggregator_tprol.f90
|
||||
impl/aggregator/amg_saggrmat_smth_bld.f90
|
||||
impl/aggregator/amg_s_soc2_map_bld.F90
|
||||
impl/aggregator/amg_s_parmatch_spmm_bld_inner.F90
|
||||
impl/aggregator/amg_caggrmat_minnrg_bld.f90
|
||||
impl/aggregator/amg_d_soc2_map_bld.F90
|
||||
impl/aggregator/amg_s_dec_aggregator_tprol.f90
|
||||
impl/aggregator/amg_s_parmatch_aggregator_inner_mat_asb.F90
|
||||
impl/aggregator/amg_s_dec_aggregator_mat_bld.f90
|
||||
impl/aggregator/amg_c_dec_aggregator_mat_asb.f90
|
||||
impl/aggregator/amg_s_rap.f90
|
||||
impl/aggregator/amg_s_map_to_tprol.f90
|
||||
impl/aggregator/amg_d_parmatch_aggregator_tprol.F90
|
||||
impl/aggregator/amg_saggrmat_nosmth_bld.f90
|
||||
impl/aggregator/amg_c_soc1_map_bld.F90
|
||||
impl/aggregator/amg_d_parmatch_aggregator_mat_asb.F90
|
||||
impl/aggregator/amg_zaggrmat_smth_bld.f90
|
||||
impl/aggregator/amg_d_parmatch_smth_bld.F90
|
||||
impl/aggregator/amg_caggrmat_nosmth_bld.f90
|
||||
impl/aggregator/amg_c_map_to_tprol.f90
|
||||
impl/aggregator/amg_d_rap.f90
|
||||
impl/aggregator/amg_d_map_to_tprol.f90
|
||||
impl/aggregator/amg_daggrmat_minnrg_bld.f90
|
||||
impl/aggregator/amg_d_dec_aggregator_mat_asb.f90
|
||||
impl/aggregator/amg_z_dec_aggregator_mat_bld.f90
|
||||
impl/aggregator/amg_d_parmatch_spmm_bld.F90
|
||||
impl/aggregator/amg_d_parmatch_aggregator_mat_bld.F90
|
||||
impl/aggregator/amg_d_ptap_bld.f90
|
||||
impl/aggregator/amg_z_symdec_aggregator_tprol.f90
|
||||
impl/aggregator/amg_s_symdec_aggregator_tprol.f90
|
||||
impl/aggregator/amg_z_soc1_map_bld.F90
|
||||
impl/aggregator/amg_d_parmatch_unsmth_bld.F90
|
||||
impl/aggregator/amg_z_map_to_tprol.f90
|
||||
impl/aggregator/amg_d_soc1_map_bld.F90
|
||||
impl/aggregator/amg_d_parmatch_spmm_bld_ov.F90
|
||||
impl/aggregator/amg_s_parmatch_aggregator_mat_bld.F90
|
||||
impl/aggregator/amg_s_parmatch_unsmth_bld.F90
|
||||
impl/aggregator/amg_d_parmatch_aggregator_inner_mat_asb.F90
|
||||
impl/aggregator/amg_s_parmatch_spmm_bld.F90
|
||||
impl/aggregator/amg_c_symdec_aggregator_tprol.f90
|
||||
impl/aggregator/amg_zaggrmat_minnrg_bld.f90
|
||||
impl/aggregator/amg_c_dec_aggregator_tprol.f90
|
||||
impl/aggregator/amg_z_dec_aggregator_mat_asb.f90
|
||||
impl/aggregator/amg_c_rap.f90
|
||||
impl/aggregator/amg_s_parmatch_spmm_bld_ov.F90
|
||||
impl/aggregator/amg_s_ptap_bld.f90
|
||||
impl/aggregator/amg_s_soc1_map_bld.F90
|
||||
impl/aggregator/amg_d_dec_aggregator_mat_bld.f90
|
||||
impl/aggregator/amg_z_ptap_bld.f90
|
||||
impl/aggregator/amg_daggrmat_smth_bld.f90
|
||||
impl/aggregator/amg_z_soc2_map_bld.F90
|
||||
impl/aggregator/amg_caggrmat_smth_bld.f90
|
||||
impl/aggregator/amg_saggrmat_minnrg_bld.f90
|
||||
impl/aggregator/amg_c_soc2_map_bld.F90
|
||||
impl/aggregator/amg_s_dec_aggregator_mat_asb.f90
|
||||
impl/aggregator/amg_z_rap.f90
|
||||
impl/aggregator/amg_s_parmatch_smth_bld.F90
|
||||
impl/aggregator/amg_c_dec_aggregator_mat_bld.f90
|
||||
impl/aggregator/amg_daggrmat_nosmth_bld.f90
|
||||
impl/aggregator/amg_d_symdec_aggregator_tprol.f90
|
||||
impl/aggregator/amg_d_parmatch_spmm_bld_inner.F90
|
||||
impl/aggregator/amg_c_ptap_bld.f90
|
||||
impl/aggregator/amg_zaggrmat_nosmth_bld.f90
|
||||
impl/amg_cmlprec_aply.f90
|
||||
impl/amg_cmlprec_bld.f90
|
||||
amg_d_invt_solver.f90
|
||||
amg_c_id_solver.f90
|
||||
amg_base_ainv_mod.F90
|
||||
amg_d_matchboxp_mod.F90
|
||||
amg_z_base_smoother_mod.f90
|
||||
amg_s_invk_solver.f90
|
||||
amg_c_base_solver_mod.f90
|
||||
amg_s_ilu_solver.f90
|
||||
amg_z_ilu_fact_mod.f90
|
||||
amg_prec_mod.f90
|
||||
amg_d_gs_solver.f90
|
||||
amg_d_jac_smoother.f90
|
||||
amg_z_symdec_aggregator_mod.f90
|
||||
amg_s_gs_solver.f90
|
||||
amg_ainv_mod.f90
|
||||
amg_d_parmatch_aggregator_mod.F90
|
||||
amg_z_as_smoother.f90
|
||||
amg_c_inner_mod.f90
|
||||
amg_d_poly_smoother.f90
|
||||
amg_z_onelev_mod.f90
|
||||
amg_z_diag_solver.f90
|
||||
amg_c_symdec_aggregator_mod.f90
|
||||
amg_c_prec_mod.f90
|
||||
amg_d_sludist_solver.F90
|
||||
amg_d_base_solver_mod.f90
|
||||
amg_c_dec_aggregator_mod.f90
|
||||
amg_c_ilu_fact_mod.f90
|
||||
amg_s_onelev_mod.f90
|
||||
amg_d_base_ainv_mod.f90
|
||||
amg_d_invk_solver.f90
|
||||
amg_z_invt_solver.f90
|
||||
amg_z_prec_mod.f90
|
||||
amg_s_prec_mod.f90
|
||||
amg_d_mumps_solver.F90
|
||||
amg_d_umf_solver.F90
|
||||
# amg_d_hybrid_aggregator_mod.F90
|
||||
amg_d_id_solver.f90
|
||||
# amg_c_hybrid_aggregator_mod.F90
|
||||
amg_z_base_ainv_mod.f90
|
||||
amg_z_sludist_solver.F90
|
||||
amg_d_ilu_solver.f90
|
||||
amg_s_base_ainv_mod.f90
|
||||
amg_c_invt_solver.f90
|
||||
# amg_s_hybrid_aggregator_mod.F90
|
||||
amg_d_prec_type.f90
|
||||
amg_d_base_smoother_mod.f90
|
||||
amg_c_base_ainv_mod.f90
|
||||
amg_s_prec_type.f90
|
||||
amg_s_diag_solver.f90
|
||||
amg_z_base_aggregator_mod.f90
|
||||
amg_z_dec_aggregator_mod.f90
|
||||
amg_prec_type.f90
|
||||
amg_s_invt_solver.f90
|
||||
amg_s_base_smoother_mod.f90
|
||||
amg_c_ainv_solver.F90
|
||||
amg_d_dec_aggregator_mod.f90
|
||||
amg_s_slu_solver.F90
|
||||
amg_d_diag_solver.f90
|
||||
amg_z_id_solver.f90
|
||||
amg_c_slu_solver.F90
|
||||
amg_s_jac_smoother.f90
|
||||
amg_s_dec_aggregator_mod.f90
|
||||
amg_d_inner_mod.f90
|
||||
amg_s_mumps_solver.F90
|
||||
amg_d_jac_solver.f90
|
||||
amg_s_krm_solver.f90
|
||||
amg_s_as_smoother.f90
|
||||
amg_d_onelev_mod.f90
|
||||
amg_z_jac_solver.f90
|
||||
amg_d_symdec_aggregator_mod.f90
|
||||
amg_c_onelev_mod.f90
|
||||
amg_s_parmatch_aggregator_mod.F90
|
||||
amg_c_ilu_solver.f90
|
||||
amg_d_poly_coeff_mod.f90
|
||||
amg_s_jac_solver.f90
|
||||
amg_base_prec_type.F90
|
||||
amg_s_base_aggregator_mod.f90
|
||||
amg_z_ainv_solver.F90
|
||||
amg_d_prec_mod.f90
|
||||
amg_c_prec_type.f90
|
||||
amg_d_as_smoother.f90
|
||||
amg_z_ilu_solver.f90
|
||||
amg_c_base_aggregator_mod.f90
|
||||
amg_s_id_solver.f90
|
||||
amg_c_krm_solver.f90
|
||||
amg_z_jac_smoother.f90
|
||||
amg_c_as_smoother.f90
|
||||
amg_z_invk_solver.f90
|
||||
amg_d_krm_solver.f90
|
||||
amg_c_invk_solver.f90
|
||||
amg_c_mumps_solver.F90
|
||||
amg_c_jac_solver.f90
|
||||
amg_z_umf_solver.F90
|
||||
amg_s_symdec_aggregator_mod.f90
|
||||
amg_s_poly_smoother.f90
|
||||
amg_s_inner_mod.f90
|
||||
amg_s_ilu_fact_mod.f90
|
||||
amg_z_mumps_solver.F90
|
||||
amg_c_jac_smoother.f90
|
||||
)
|
||||
foreach(file IN LISTS AMG_amgprec_source_files)
|
||||
list(APPEND amgprec_source_files ${CMAKE_CURRENT_LIST_DIR}/${file})
|
||||
endforeach()
|
||||
|
||||
|
||||
list(APPEND AMG_amgprec_source_C_files impl/amg_dslu_interface.c)
|
||||
list(APPEND AMG_amgprec_source_C_files impl/amg_zslu_interface.c)
|
||||
list(APPEND AMG_amgprec_source_C_files impl/amg_sslu_interface.c)
|
||||
list(APPEND AMG_amgprec_source_C_files impl/amg_dumf_interface.c)
|
||||
list(APPEND AMG_amgprec_source_C_files impl/amg_cslu_interface.c)
|
||||
list(APPEND AMG_amgprec_source_C_files impl/amg_dslud_interface.c)
|
||||
list(APPEND AMG_amgprec_source_C_files impl/amg_zumf_interface.c)
|
||||
list(APPEND AMG_amgprec_source_C_files impl/amg_zslud_interface.c)
|
||||
|
||||
|
||||
set(AMG_amgprec_source_CPP_files
|
||||
impl/aggregator/computeCandidateMate.cpp
|
||||
impl/aggregator/processExposedVertex.cpp
|
||||
impl/aggregator/processMatchedVertices.cpp
|
||||
impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.cpp
|
||||
impl/aggregator/processCrossEdge.cpp
|
||||
impl/aggregator/findOwnerOfGhost.cpp
|
||||
impl/aggregator/MatchBoxPC.cpp
|
||||
impl/aggregator/queueTransfer.cpp
|
||||
impl/aggregator/clean.cpp
|
||||
impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.cpp
|
||||
impl/aggregator/extractUChunk.cpp
|
||||
impl/aggregator/processMatchedVerticesAndSendMessages.cpp
|
||||
impl/aggregator/sendBundledMessages.cpp
|
||||
impl/aggregator/initialize.cpp
|
||||
impl/aggregator/isAlreadyMatched.cpp
|
||||
impl/aggregator/processMessages.cpp
|
||||
impl/aggregator/parallelComputeCandidateMateB.cpp
|
||||
)
|
||||
|
||||
|
||||
foreach(file IN LISTS AMG_amgprec_source_C_files)
|
||||
list(APPEND amgprec_source_C_files ${CMAKE_CURRENT_LIST_DIR}/${file})
|
||||
endforeach()
|
||||
|
||||
|
||||
foreach(file IN LISTS AMG_amgprec_source_CPP_files)
|
||||
list(APPEND amgprec_source_CPP_files ${CMAKE_CURRENT_LIST_DIR}/${file})
|
||||
endforeach()
|
||||
+43
-51
@@ -9,46 +9,48 @@ FINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(INCDIR) $(PSBLAS_INCLUDES)
|
||||
|
||||
DMODOBJS=amg_d_prec_type.o \
|
||||
amg_d_inner_mod.o amg_d_ilu_solver.o amg_d_diag_solver.o amg_d_jac_smoother.o amg_d_as_smoother.o \
|
||||
amg_d_poly_smoother.o amg_d_poly_coeff_mod.o\
|
||||
amg_d_umf_solver.o amg_d_slu_solver.o amg_d_sludist_solver.o amg_d_id_solver.o\
|
||||
amg_d_base_solver_mod.o amg_d_base_smoother_mod.o amg_d_onelev_mod.o \
|
||||
amg_d_gs_solver.o amg_d_mumps_solver.o amg_d_jac_solver.o \
|
||||
amg_d_gs_solver.o amg_d_mumps_solver.o \
|
||||
amg_d_base_aggregator_mod.o \
|
||||
amg_d_dec_aggregator_mod.o amg_d_symdec_aggregator_mod.o \
|
||||
amg_d_ainv_solver.o amg_d_base_ainv_mod.o \
|
||||
amg_d_invk_solver.o amg_d_invt_solver.o amg_d_krm_solver.o \
|
||||
amg_d_matchboxp_mod.o amg_d_parmatch_aggregator_mod.o
|
||||
amg_d_invk_solver.o amg_d_invt_solver.o \
|
||||
amg_d_rkr_solver.o
|
||||
#amg_d_bcmatch_aggregator_mod.o
|
||||
|
||||
SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \
|
||||
amg_s_inner_mod.o amg_s_ilu_solver.o amg_s_diag_solver.o amg_s_jac_smoother.o amg_s_as_smoother.o \
|
||||
amg_s_poly_smoother.o amg_s_slu_solver.o amg_s_id_solver.o\
|
||||
amg_s_slu_solver.o amg_s_id_solver.o\
|
||||
amg_s_base_solver_mod.o amg_s_base_smoother_mod.o amg_s_onelev_mod.o \
|
||||
amg_s_gs_solver.o amg_s_mumps_solver.o amg_s_jac_solver.o \
|
||||
amg_s_gs_solver.o amg_s_mumps_solver.o \
|
||||
amg_s_base_aggregator_mod.o \
|
||||
amg_s_dec_aggregator_mod.o amg_s_symdec_aggregator_mod.o \
|
||||
amg_s_ainv_solver.o amg_s_base_ainv_mod.o \
|
||||
amg_s_invk_solver.o amg_s_invt_solver.o amg_s_krm_solver.o \
|
||||
amg_s_matchboxp_mod.o amg_s_parmatch_aggregator_mod.o
|
||||
amg_s_invk_solver.o amg_s_invt_solver.o \
|
||||
amg_s_rkr_solver.o
|
||||
|
||||
ZMODOBJS=amg_z_prec_type.o amg_z_ilu_fact_mod.o \
|
||||
amg_z_inner_mod.o amg_z_ilu_solver.o amg_z_diag_solver.o amg_z_jac_smoother.o amg_z_as_smoother.o \
|
||||
amg_z_umf_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o amg_z_id_solver.o\
|
||||
amg_z_base_solver_mod.o amg_z_base_smoother_mod.o amg_z_onelev_mod.o \
|
||||
amg_z_gs_solver.o amg_z_mumps_solver.o amg_z_jac_solver.o \
|
||||
amg_z_gs_solver.o amg_z_mumps_solver.o \
|
||||
amg_z_base_aggregator_mod.o \
|
||||
amg_z_dec_aggregator_mod.o amg_z_symdec_aggregator_mod.o \
|
||||
amg_z_ainv_solver.o amg_z_base_ainv_mod.o \
|
||||
amg_z_invk_solver.o amg_z_invt_solver.o amg_z_krm_solver.o
|
||||
amg_z_invk_solver.o amg_z_invt_solver.o \
|
||||
amg_z_rkr_solver.o
|
||||
|
||||
CMODOBJS=amg_c_prec_type.o amg_c_ilu_fact_mod.o \
|
||||
amg_c_inner_mod.o amg_c_ilu_solver.o amg_c_diag_solver.o amg_c_jac_smoother.o amg_c_as_smoother.o \
|
||||
amg_c_slu_solver.o amg_c_id_solver.o\
|
||||
amg_c_base_solver_mod.o amg_c_base_smoother_mod.o amg_c_onelev_mod.o \
|
||||
amg_c_gs_solver.o amg_c_mumps_solver.o amg_c_jac_solver.o \
|
||||
amg_c_gs_solver.o amg_c_mumps_solver.o \
|
||||
amg_c_base_aggregator_mod.o \
|
||||
amg_c_dec_aggregator_mod.o amg_c_symdec_aggregator_mod.o \
|
||||
amg_c_ainv_solver.o amg_c_base_ainv_mod.o \
|
||||
amg_c_invk_solver.o amg_c_invt_solver.o amg_c_krm_solver.o
|
||||
amg_c_invk_solver.o amg_c_invt_solver.o \
|
||||
amg_c_rkr_solver.o
|
||||
|
||||
|
||||
|
||||
@@ -58,41 +60,30 @@ 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)
|
||||
OBJS=$(MODOBJS)
|
||||
|
||||
LOCAL_MODS=$(MODOBJS:.o=$(.mod))
|
||||
LIBNAME=libamg_prec.a
|
||||
|
||||
all: mods objs impld
|
||||
all: lib impld
|
||||
|
||||
mods: $(MODOBJS)
|
||||
/bin/cp -p amg_config.h $(INCDIR)
|
||||
/bin/cp -p *$(.mod) $(MODDIR)
|
||||
objs: mods impld
|
||||
impld: mods
|
||||
cd impl && $(MAKE)
|
||||
impld: $(OBJS)
|
||||
$(MAKE) -C impl
|
||||
|
||||
lib: objs
|
||||
cd impl && $(MAKE) lib
|
||||
$(AR) $(HERE)/$(LIBNAME) $(MODOBJS)
|
||||
lib: $(OBJS) impld
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
|
||||
/bin/cp -p amg_const.h $(INCDIR)
|
||||
/bin/cp -p *$(.mod) $(MODDIR)
|
||||
|
||||
|
||||
$(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
|
||||
$(MODOBJS): $(PSBLAS_MODDIR)/$(BASEMODNAME)$(.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
|
||||
amg_s_krm_solver.o: amg_s_prec_type.o amg_s_base_solver_mod.o
|
||||
amg_d_krm_solver.o: amg_d_prec_type.o amg_d_base_solver_mod.o
|
||||
amg_c_krm_solver.o: amg_c_prec_type.o amg_c_base_solver_mod.o
|
||||
amg_z_krm_solver.o: amg_z_prec_type.o amg_z_base_solver_mod.o
|
||||
|
||||
amg_s_prec_mod.o: amg_s_krm_solver.o
|
||||
amg_d_prec_mod.o: amg_d_krm_solver.o
|
||||
amg_c_prec_mod.o: amg_c_krm_solver.o
|
||||
amg_z_prec_mod.o: amg_z_krm_solver.o
|
||||
|
||||
$(SINNEROBJS) $(SOUTEROBJS): $(SMODOBJS)
|
||||
$(DINNEROBJS) $(DOUTEROBJS): $(DMODOBJS)
|
||||
@@ -115,27 +106,25 @@ amg_d_prec_type.o: amg_d_onelev_mod.o
|
||||
amg_c_prec_type.o: amg_c_onelev_mod.o
|
||||
amg_z_prec_type.o: amg_z_onelev_mod.o
|
||||
|
||||
amg_s_onelev_mod.o: amg_s_base_smoother_mod.o amg_s_dec_aggregator_mod.o amg_s_parmatch_aggregator_mod.o
|
||||
amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o amg_d_parmatch_aggregator_mod.o
|
||||
amg_s_onelev_mod.o: amg_s_base_smoother_mod.o amg_s_dec_aggregator_mod.o
|
||||
amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o
|
||||
amg_c_onelev_mod.o: amg_c_base_smoother_mod.o amg_c_dec_aggregator_mod.o
|
||||
amg_z_onelev_mod.o: amg_z_base_smoother_mod.o amg_z_dec_aggregator_mod.o
|
||||
|
||||
amg_s_base_aggregator_mod.o: amg_base_prec_type.o
|
||||
amg_s_parmatch_aggregator_mod.o amg_s_dec_aggregator_mod.o: amg_s_base_aggregator_mod.o
|
||||
amg_s_dec_aggregator_mod.o: amg_s_base_aggregator_mod.o
|
||||
amg_s_hybrid_aggregator_mod.o amg_s_symdec_aggregator_mod.o: amg_s_dec_aggregator_mod.o
|
||||
amg_s_parmatch_aggregator_mod.o: amg_s_matchboxp_mod.o
|
||||
|
||||
amg_d_base_aggregator_mod.o: amg_base_prec_type.o
|
||||
amg_d_parmatch_aggregator_mod.o amg_d_dec_aggregator_mod.o: amg_d_base_aggregator_mod.o
|
||||
amg_d_dec_aggregator_mod.o: amg_d_base_aggregator_mod.o
|
||||
amg_d_hybrid_aggregator_mod.o amg_d_symdec_aggregator_mod.o: amg_d_dec_aggregator_mod.o
|
||||
amg_d_parmatch_aggregator_mod.o: amg_d_matchboxp_mod.o
|
||||
|
||||
amg_c_base_aggregator_mod.o: amg_base_prec_type.o
|
||||
amg_c_parmatch_aggregator_mod.o amg_c_dec_aggregator_mod.o: amg_c_base_aggregator_mod.o
|
||||
amg_c_dec_aggregator_mod.o: amg_c_base_aggregator_mod.o
|
||||
amg_c_hybrid_aggregator_mod.o amg_c_symdec_aggregator_mod.o: amg_c_dec_aggregator_mod.o
|
||||
|
||||
amg_z_base_aggregator_mod.o: amg_base_prec_type.o
|
||||
amg_z_parmatch_aggregator_mod.o amg_z_dec_aggregator_mod.o: amg_z_base_aggregator_mod.o
|
||||
amg_z_dec_aggregator_mod.o: amg_z_base_aggregator_mod.o
|
||||
amg_z_hybrid_aggregator_mod.o amg_z_symdec_aggregator_mod.o: amg_z_dec_aggregator_mod.o
|
||||
|
||||
amg_s_base_smoother_mod.o: amg_s_base_solver_mod.o
|
||||
@@ -152,10 +141,15 @@ amg_c_base_ainv_mod.o: amg_c_base_solver_mod.o amg_base_ainv_mod.o
|
||||
amg_d_base_ainv_mod.o: amg_d_base_solver_mod.o amg_base_ainv_mod.o
|
||||
amg_z_base_ainv_mod.o: amg_z_base_solver_mod.o amg_base_ainv_mod.o
|
||||
|
||||
amg_d_rkr_solver.o: amg_d_base_solver_mod.o amg_d_prec_type.o
|
||||
amg_s_rkr_solver.o: amg_s_base_solver_mod.o amg_s_prec_type.o
|
||||
amg_c_rkr_solver.o: amg_c_base_solver_mod.o amg_c_prec_type.o
|
||||
amg_z_rkr_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.o
|
||||
|
||||
amg_s_base_solver_mod.o amg_d_base_solver_mod.o amg_c_base_solver_mod.o amg_z_base_solver_mod.o: amg_base_prec_type.o
|
||||
|
||||
amg_d_mumps_solver.o amg_d_gs_solver.o amg_d_id_solver.o amg_d_sludist_solver.o amg_d_slu_solver.o \
|
||||
amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o amg_d_jac_solver.o: amg_d_base_solver_mod.o amg_d_prec_type.o
|
||||
amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o: amg_d_base_solver_mod.o amg_d_prec_type.o
|
||||
|
||||
#amg_d_ilu_fact_mod.o: amg_base_prec_type.o amg_d_base_solver_mod.o
|
||||
#amg_d_ilu_solver.o amg_d_iluk_fact.o: amg_d_ilu_fact_mod.o
|
||||
@@ -164,11 +158,9 @@ amg_d_jac_smoother.o: amg_d_diag_solver.o
|
||||
amg_dprecinit.o amg_dprecset.o: amg_d_diag_solver.o amg_d_ilu_solver.o \
|
||||
amg_d_umf_solver.o amg_d_as_smoother.o amg_d_jac_smoother.o \
|
||||
amg_d_id_solver.o amg_d_slu_solver.o amg_d_sludist_solver.o
|
||||
amg_d_poly_smoother.o: amg_d_base_smoother_mod.o amg_d_poly_coeff_mod.o
|
||||
amg_s_poly_smoother.o: amg_s_base_smoother_mod.o amg_d_poly_coeff_mod.o
|
||||
|
||||
amg_s_mumps_solver.o amg_s_gs_solver.o amg_s_id_solver.o amg_s_slu_solver.o \
|
||||
amg_s_diag_solver.o amg_s_ilu_solver.o amg_s_jac_solver.o: amg_s_base_solver_mod.o amg_s_prec_type.o
|
||||
amg_s_diag_solver.o amg_s_ilu_solver.o: amg_s_base_solver_mod.o amg_s_prec_type.o
|
||||
amg_s_ilu_fact_mod.o: amg_base_prec_type.o amg_s_base_solver_mod.o
|
||||
amg_s_ilu_solver.o amg_s_iluk_fact.o: amg_s_ilu_fact_mod.o
|
||||
amg_s_as_smoother.o amg_s_jac_smoother.o: amg_s_base_smoother_mod.o
|
||||
@@ -178,7 +170,7 @@ amg_sprecinit.o amg_sprecset.o: amg_s_diag_solver.o amg_s_ilu_solver.o \
|
||||
amg_s_id_solver.o amg_s_slu_solver.o
|
||||
|
||||
amg_z_mumps_solver.o amg_z_gs_solver.o amg_z_id_solver.o amg_z_sludist_solver.o amg_z_slu_solver.o \
|
||||
amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o amg_z_jac_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.o
|
||||
amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.o
|
||||
amg_z_ilu_fact_mod.o: amg_base_prec_type.o amg_z_base_solver_mod.o
|
||||
amg_z_ilu_solver.o amg_z_iluk_fact.o: amg_z_ilu_fact_mod.o
|
||||
amg_z_as_smoother.o amg_z_jac_smoother.o: amg_z_base_smoother_mod.o
|
||||
@@ -188,7 +180,7 @@ amg_zprecinit.o amg_zprecset.o: amg_z_diag_solver.o amg_z_ilu_solver.o \
|
||||
amg_z_id_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o
|
||||
|
||||
amg_c_mumps_solver.o amg_c_gs_solver.o amg_c_id_solver.o amg_c_sludist_solver.o amg_c_slu_solver.o \
|
||||
amg_c_diag_solver.o amg_c_ilu_solver.o amg_c_jac_solver.o: amg_c_base_solver_mod.o amg_c_prec_type.o
|
||||
amg_c_diag_solver.o amg_c_ilu_solver.o: amg_c_base_solver_mod.o amg_c_prec_type.o
|
||||
amg_c_ilu_fact_mod.o: amg_base_prec_type.o amg_c_base_solver_mod.o
|
||||
amg_c_ilu_solver.o amg_c_iluk_fact.o: amg_c_ilu_fact_mod.o
|
||||
amg_c_as_smoother.o amg_c_jac_smoother.o: amg_c_base_smoother_mod.o
|
||||
@@ -220,7 +212,7 @@ veryclean: clean
|
||||
/bin/rm -f $(LIBNAME)
|
||||
|
||||
clean: implclean
|
||||
/bin/rm -f $(MODOBJS) $(LOCAL_MODS) *$(.mod)
|
||||
/bin/rm -f $(OBJS) $(LOCAL_MODS) *$(.mod)
|
||||
|
||||
implclean:
|
||||
cd impl && $(MAKE) clean
|
||||
$(MAKE) -C impl clean
|
||||
|
||||
@@ -17,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -17,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -55,6 +55,10 @@ module amg_base_ainv_mod
|
||||
integer, parameter :: amg_ainv_llk_noth_ = amg_ainv_s_ft_llk_ + 1
|
||||
integer, parameter :: amg_ainv_mlk_ = amg_ainv_llk_noth_ + 1
|
||||
integer, parameter :: amg_ainv_lmx_ = amg_ainv_mlk_
|
||||
#if defined(HAVE_TUMA_SAINV)
|
||||
integer, parameter :: amg_ainv_s_tuma_ = amg_ainv_lmx_ + 1
|
||||
integer, parameter :: amg_ainv_l_tuma_ = amg_ainv_s_tuma_ + 1
|
||||
#endif
|
||||
|
||||
|
||||
end module amg_base_ainv_mod
|
||||
|
||||
+233
-416
File diff suppressed because it is too large
Load Diff
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
@@ -20,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -58,10 +55,13 @@ module amg_c_ainv_solver
|
||||
procedure, pass(sv) :: check => amg_c_ainv_solver_check
|
||||
procedure, pass(sv) :: build => amg_c_ainv_solver_bld
|
||||
procedure, pass(sv) :: clone => amg_c_ainv_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_c_ainv_solver_clone_settings
|
||||
procedure, pass(sv) :: cseti => amg_c_ainv_solver_cseti
|
||||
procedure, pass(sv) :: csetc => amg_c_ainv_solver_csetc
|
||||
procedure, pass(sv) :: csetr => amg_c_ainv_solver_csetr
|
||||
procedure, pass(sv) :: seti => amg_c_ainv_solver_seti
|
||||
procedure, pass(sv) :: setc => amg_c_ainv_solver_setc
|
||||
procedure, pass(sv) :: setr => amg_c_ainv_solver_setr
|
||||
generic, public :: set => seti, setr, setc
|
||||
procedure, pass(sv) :: descr => amg_c_ainv_solver_descr
|
||||
procedure, pass(sv) :: default => c_ainv_solver_default
|
||||
procedure, nopass :: stringval => c_ainv_stringval
|
||||
@@ -83,16 +83,6 @@ module amg_c_ainv_solver
|
||||
end subroutine amg_c_ainv_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& amg_c_base_solver_type, psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_ainv_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
@@ -103,7 +93,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
|
||||
@@ -169,44 +159,44 @@ module amg_c_ainv_solver
|
||||
end subroutine amg_c_ainv_solver_csetr
|
||||
end interface
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine amg_c_ainv_solver_setc(sv,what,val,info)
|
||||
!!$ import :: amg_c_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ character(len=*), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_c_ainv_solver_setc
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_c_ainv_solver_seti(sv,what,val,info)
|
||||
!!$ import :: amg_c_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ integer(psb_ipk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_c_ainv_solver_seti
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_c_ainv_solver_setr(sv,what,val,info)
|
||||
!!$ import :: amg_c_ainv_solver_type, psb_ipk_, psb_spk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ real(psb_spk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_c_ainv_solver_setr
|
||||
!!$ end interface
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_setc(sv,what,val,info)
|
||||
import :: amg_c_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_ainv_solver_setc
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_c_ainv_solver_seti(sv,what,val,info)
|
||||
import :: amg_c_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_ainv_solver_seti
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_setr(sv,what,val,info)
|
||||
import :: amg_c_ainv_solver_type, psb_ipk_, psb_spk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_ainv_solver_setr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -216,7 +206,7 @@ module amg_c_ainv_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_c_ainv_solver_descr
|
||||
end interface
|
||||
|
||||
@@ -225,7 +215,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
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -396,23 +396,21 @@ contains
|
||||
end subroutine c_as_smoother_default
|
||||
|
||||
|
||||
subroutine c_as_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine c_as_smoother_descr(sm,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_as_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_as_smoother_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
logical :: coarse_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -426,21 +424,16 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (.not.coarse_) then
|
||||
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
|
||||
write(iout_,*) ' Additive Schwarz with ',&
|
||||
& sm%novr, ' overlap layers.'
|
||||
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) trim(prefix_), ' Local solver:'
|
||||
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) ' Local solver:'
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
|
||||
call sm%sv%descr(info,iout_,coarse=coarse)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -89,7 +89,7 @@ module amg_c_base_aggregator_mod
|
||||
procedure, pass(ag) :: bld_tprol => amg_c_base_aggregator_build_tprol
|
||||
procedure, pass(ag) :: mat_bld => amg_c_base_aggregator_mat_bld
|
||||
procedure, pass(ag) :: mat_asb => amg_c_base_aggregator_mat_asb
|
||||
procedure, pass(ag) :: bld_linmap => amg_c_base_aggregator_bld_linmap
|
||||
procedure, pass(ag) :: bld_map => amg_c_base_aggregator_bld_map
|
||||
procedure, pass(ag) :: update_next => amg_c_base_aggregator_update_next
|
||||
procedure, pass(ag) :: clone => amg_c_base_aggregator_clone
|
||||
procedure, pass(ag) :: free => amg_c_base_aggregator_free
|
||||
@@ -126,7 +126,7 @@ module amg_c_base_aggregator_mod
|
||||
& psb_c_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_c_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_c_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -144,7 +144,7 @@ module amg_c_base_aggregator_mod
|
||||
& psb_c_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_c_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_c_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -275,22 +275,15 @@ contains
|
||||
val = .false.
|
||||
end function amg_c_base_aggregator_xt_desc
|
||||
|
||||
subroutine amg_c_base_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_c_base_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_c_base_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_c_base_aggregator_descr
|
||||
@@ -302,7 +295,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Do nothing
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
end subroutine amg_c_base_aggregator_set_aggr_type
|
||||
|
||||
@@ -458,7 +451,7 @@ contains
|
||||
end subroutine amg_c_base_aggregator_mat_asb
|
||||
|
||||
!
|
||||
!> Function bld_linmap
|
||||
!> Function bld_map
|
||||
!! \memberof amg_c_base_aggregator_type
|
||||
!! \brief Build linear map between hierarchy levels
|
||||
!!
|
||||
@@ -473,7 +466,7 @@ contains
|
||||
!! \param map The output map
|
||||
!! \param info Return code
|
||||
!!
|
||||
subroutine amg_c_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
subroutine amg_c_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
@@ -484,9 +477,8 @@ contains
|
||||
type(psb_clinmap_type), intent(out) :: map
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_base_aggregator_bld_linmap'
|
||||
character(len=20) :: name='c_base_aggregator_bld_map'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
!
|
||||
! Copy the prolongation/restriction matrices into the descriptor map.
|
||||
@@ -508,6 +500,7 @@ contains
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine amg_c_base_aggregator_bld_linmap
|
||||
end subroutine amg_c_base_aggregator_bld_map
|
||||
|
||||
|
||||
end module amg_c_base_aggregator_mod
|
||||
|
||||
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
@@ -20,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -272,7 +272,7 @@ module amg_c_base_smoother_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_base_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_c_base_smoother_descr(sm,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_base_smoother_type, psb_ipk_
|
||||
@@ -281,7 +281,6 @@ module amg_c_base_smoother_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_c_base_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -270,7 +270,7 @@ module amg_c_base_solver_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_base_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_c_base_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_base_solver_type, psb_ipk_
|
||||
@@ -281,7 +281,7 @@ module amg_c_base_solver_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_c_base_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -150,7 +150,7 @@ contains
|
||||
class(amg_c_dec_aggregator_type), intent(inout) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
info = psb_success_
|
||||
|
||||
select case(parms%aggr_type)
|
||||
case (amg_noalg_)
|
||||
ag%soc_map_bld => null()
|
||||
@@ -184,24 +184,16 @@ contains
|
||||
val = "Decoupled aggregation"
|
||||
end function amg_c_dec_aggregator_fmt
|
||||
|
||||
subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_c_dec_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
info = psb_success_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Decoupled Aggregator'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_c_dec_aggregator_descr
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -219,7 +219,7 @@ contains
|
||||
|
||||
end subroutine c_diag_solver_free
|
||||
|
||||
subroutine c_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -228,13 +228,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -242,13 +240,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Diagonal local solver '
|
||||
|
||||
write(iout_,*) ' Diagonal local solver '
|
||||
|
||||
return
|
||||
|
||||
@@ -331,7 +324,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
|
||||
@@ -359,7 +352,7 @@ module amg_c_l1_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_l1_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -368,13 +361,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_l1_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -382,13 +373,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
|
||||
|
||||
write(iout_,*) ' L1 Diagonal solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
+17
-31
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -433,22 +433,20 @@ contains
|
||||
return
|
||||
end subroutine c_gs_solver_free
|
||||
|
||||
subroutine c_gs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_gs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_gs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_gs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -457,17 +455,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
@@ -533,22 +526,20 @@ contains
|
||||
val = .true.
|
||||
end function c_gs_solver_is_iterative
|
||||
|
||||
subroutine c_bwgs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_bwgs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_bwgs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_bwgs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -557,17 +548,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
|
||||
@@ -0,0 +1,125 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
|
||||
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
! POSSIBILITY OF SUCH DAMAGE.
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! The aggregator object hosts the aggregation method for building
|
||||
! the multilevel hierarchy. This variant is based on the hybrid method
|
||||
! presented in
|
||||
!
|
||||
! S. Gratton, P. Henon, P. Jiranek and X. Vasseur:
|
||||
! Reducing complexity of algebraic multigrid by aggregation
|
||||
! Numerical Lin. Algebra with Applications, 2016, 23:501-518
|
||||
!
|
||||
module amg_c_hybrid_aggregator_mod
|
||||
|
||||
use amg_c_dec_aggregator_mod
|
||||
!
|
||||
! sm - class(amg_T_base_smoother_type), allocatable
|
||||
! The current level preconditioner (aka smoother).
|
||||
! parms - type(amg_RTml_parms)
|
||||
! The parameters defining the multilevel strategy.
|
||||
! ac - The local part of the current-level matrix, built by
|
||||
! coarsening the previous-level matrix.
|
||||
! desc_ac - type(psb_desc_type).
|
||||
! The communication descriptor associated to the matrix
|
||||
! stored in ac.
|
||||
! base_a - type(psb_Tspmat_type), pointer.
|
||||
! Pointer (really a pointer!) to the local part of the current
|
||||
! matrix (so we have a unified treatment of residuals).
|
||||
! We need this to avoid passing explicitly the current matrix
|
||||
! to the routine which applies the preconditioner.
|
||||
! base_desc - type(psb_desc_type), pointer.
|
||||
! Pointer to the communication descriptor associated to the
|
||||
! matrix pointed by base_a.
|
||||
! map - Stores the maps (restriction and prolongation) between the
|
||||
! vector spaces associated to the index spaces of the previous
|
||||
! and current levels.
|
||||
!
|
||||
! Methods:
|
||||
! Most methods follow the encapsulation hierarchy: they take whatever action
|
||||
! is appropriate for the current object, then call the corresponding method for
|
||||
! the contained object.
|
||||
! As an example: the descr() method prints out a description of the
|
||||
! level. It starts by invoking the descr() method of the parms object,
|
||||
! then calls the descr() method of the smoother object.
|
||||
!
|
||||
! descr - Prints a description of the object.
|
||||
! default - Set default values
|
||||
! dump - Dump to file object contents
|
||||
! set - Sets various parameters; when a request is unknown
|
||||
! it is passed to the smoother object for further processing.
|
||||
! check - Sanity checks.
|
||||
! sizeof - Total memory occupation in bytes
|
||||
! get_nzeros - Number of nonzeros
|
||||
!
|
||||
!
|
||||
type, extends(amg_c_dec_aggregator_type) :: amg_c_hybrid_aggregator_type
|
||||
|
||||
contains
|
||||
procedure, pass(ag) :: bld_tprol => amg_c_hybrid_aggregator_build_tprol
|
||||
procedure, nopass :: fmt => amg_c_hybrid_aggregator_fmt
|
||||
end type amg_c_hybrid_aggregator_type
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_c_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
import :: amg_c_hybrid_aggregator_type, psb_desc_type, psb_cspmat_type, psb_spk_, &
|
||||
& psb_ipk_, psb_long_int_k_, amg_sml_parms
|
||||
implicit none
|
||||
class(amg_c_hybrid_aggregator_type), target, intent(inout) :: ag
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_cspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
|
||||
type(psb_cspmat_type), intent(out) :: op_prol
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_hybrid_aggregator_build_tprol
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
|
||||
function amg_c_hybrid_aggregator_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Hybrid Decoupled aggregation"
|
||||
end function amg_c_hybrid_aggregator_fmt
|
||||
|
||||
|
||||
end module amg_c_hybrid_aggregator_mod
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -157,7 +157,7 @@ contains
|
||||
return
|
||||
end subroutine c_id_solver_free
|
||||
|
||||
subroutine c_id_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_id_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -165,14 +165,12 @@ contains
|
||||
class(amg_c_id_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_id_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -180,13 +178,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Identity local solver '
|
||||
write(iout_,*) ' Identity local solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -234,7 +234,7 @@ contains
|
||||
! Arguments
|
||||
class(amg_c_ilu_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%fact_type = amg_ilu_n_
|
||||
sv%fact_type = psb_ilu_n_
|
||||
sv%fill_in = 0
|
||||
sv%thresh = szero
|
||||
|
||||
@@ -255,13 +255,13 @@ contains
|
||||
info = psb_success_
|
||||
|
||||
call amg_check_def(sv%fact_type,&
|
||||
& 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
|
||||
& 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
|
||||
|
||||
select case(sv%fact_type)
|
||||
case(amg_ilu_n_,amg_milu_n_)
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
call amg_check_def(sv%fill_in,&
|
||||
& 'Level',izero,is_int_non_negative)
|
||||
case(amg_ilu_t_)
|
||||
case(psb_ilu_t_)
|
||||
call amg_check_def(sv%thresh,&
|
||||
& 'Eps',szero,is_legal_s_fact_thrs)
|
||||
end select
|
||||
@@ -406,7 +406,7 @@ contains
|
||||
return
|
||||
end subroutine c_ilu_solver_free
|
||||
|
||||
subroutine c_ilu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_ilu_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -414,14 +414,12 @@ contains
|
||||
class(amg_c_ilu_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_ilu_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -430,20 +428,15 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
|
||||
write(iout_,*) ' Incomplete factorization solver: ',&
|
||||
& amg_fact_names(sv%fact_type)
|
||||
select case(sv%fact_type)
|
||||
case(amg_ilu_n_,amg_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
case(amg_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -496,7 +489,7 @@ contains
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_ilu_n_
|
||||
val = psb_ilu_n_
|
||||
end function c_ilu_solver_get_id
|
||||
|
||||
function c_ilu_solver_get_wrksize() result(val)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -39,7 +39,7 @@
|
||||
!
|
||||
! Module: amg_inner_mod
|
||||
!
|
||||
! This module defines the interfaces to inner AMG4PSBLAS routines.
|
||||
! This module defines the interfaces to inner MLD2P4 routines.
|
||||
! The interfaces of the user level routines are defined in amg_prec_mod.f90.
|
||||
!
|
||||
module amg_c_inner_mod
|
||||
@@ -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
|
||||
@@ -67,7 +67,7 @@ module amg_c_inner_mod
|
||||
end interface amg_mlprec_bld
|
||||
|
||||
interface amg_mlprec_aply
|
||||
subroutine amg_cmlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
subroutine amg_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: amg_cprec_type
|
||||
implicit none
|
||||
@@ -79,7 +79,7 @@ module amg_c_inner_mod
|
||||
character,intent(in) :: trans
|
||||
complex(psb_spk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_cmlprec_aply_a
|
||||
end subroutine amg_cmlprec_aply
|
||||
subroutine amg_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
import :: psb_cspmat_type, psb_desc_type, &
|
||||
& psb_spk_, psb_c_vect_type, psb_ipk_
|
||||
@@ -109,12 +109,11 @@ module amg_c_inner_mod
|
||||
end interface amg_map_to_tprol
|
||||
|
||||
abstract interface
|
||||
subroutine amg_caggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
subroutine amg_caggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_, psb_lcspmat_type
|
||||
import :: amg_c_onelev_type, amg_sml_parms
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
type(psb_cspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
|
||||
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
@@ -20,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -52,9 +49,10 @@ module amg_c_invk_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_c_invk_solver_check
|
||||
procedure, pass(sv) :: clone => amg_c_invk_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_c_invk_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_c_invk_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_c_invk_solver_cseti
|
||||
procedure, pass(sv) :: seti => amg_c_invk_solver_seti
|
||||
generic, public :: set => seti
|
||||
procedure, pass(sv) :: descr => amg_c_invk_solver_descr
|
||||
procedure, pass(sv) :: default => c_invk_solver_default
|
||||
end type amg_c_invk_solver_type
|
||||
@@ -74,17 +72,6 @@ module amg_c_invk_solver
|
||||
end subroutine amg_c_invk_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invk_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& amg_c_base_solver_type, psb_spk_, amg_c_invk_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_c_invk_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_invk_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
@@ -94,7 +81,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
|
||||
@@ -135,7 +122,7 @@ module amg_c_invk_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invk_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_c_invk_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_spk_, amg_c_invk_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -145,10 +132,22 @@ module amg_c_invk_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_c_invk_solver_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invk_solver_seti(sv,what,val,info)
|
||||
import :: amg_c_invk_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_c_invk_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_invk_solver_seti
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_invk_solver_default(sv)
|
||||
|
||||
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
@@ -20,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -52,10 +49,12 @@ module amg_c_invt_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_c_invt_solver_check
|
||||
procedure, pass(sv) :: clone => amg_c_invt_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_c_invt_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_c_invt_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_c_invt_solver_cseti
|
||||
procedure, pass(sv) :: csetr => amg_c_invt_solver_csetr
|
||||
procedure, pass(sv) :: seti => amg_c_invt_solver_seti
|
||||
procedure, pass(sv) :: setr => amg_c_invt_solver_setr
|
||||
generic, public :: set => seti, setr
|
||||
procedure, pass(sv) :: descr => amg_c_invt_solver_descr
|
||||
procedure, pass(sv) :: default => c_invt_solver_default
|
||||
end type amg_c_invt_solver_type
|
||||
@@ -74,17 +73,6 @@ module amg_c_invt_solver
|
||||
end subroutine amg_c_invt_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invt_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& amg_c_base_solver_type, psb_spk_, amg_c_invt_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_c_invt_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_invt_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
@@ -94,7 +82,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
|
||||
@@ -146,21 +134,44 @@ module amg_c_invt_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invt_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_c_invt_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_spk_, amg_c_invt_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_invt_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
end subroutine amg_c_invt_solver_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invt_solver_setr(sv,what,val,info)
|
||||
import :: amg_c_invt_solver_type, psb_spk_, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_c_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_invt_solver_setr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invt_solver_seti(sv,what,val,info)
|
||||
import :: amg_c_invt_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_c_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_invt_solver_default(sv)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -203,8 +203,8 @@ module amg_c_jac_smoother
|
||||
subroutine amg_c_jac_smoother_clone_settings(sm,smout,info)
|
||||
import :: amg_c_jac_smoother_type, psb_spk_, &
|
||||
& amg_c_base_smoother_type, psb_ipk_
|
||||
class(amg_c_jac_smoother_type), intent(inout) :: sm
|
||||
class(amg_c_base_smoother_type), intent(inout) :: smout
|
||||
class(amg_c_jac_smoother_type), intent(inout) :: sm
|
||||
class(amg_c_base_smoother_type), allocatable, intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_jac_smoother_clone_settings
|
||||
end interface
|
||||
@@ -219,13 +219,12 @@ module amg_c_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_c_jac_smoother_type, psb_ipk_
|
||||
class(amg_c_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_c_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
@@ -274,7 +273,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
|
||||
@@ -314,13 +313,12 @@ module amg_c_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_c_l1_jac_smoother_type, psb_ipk_
|
||||
class(amg_c_l1_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_c_l1_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -1,585 +0,0 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific 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_c_jac_solver_mod.f90
|
||||
!
|
||||
! Module: amg_c_jac_solver_mod
|
||||
!
|
||||
! This module defines:
|
||||
! - the amg_c_jac_solver_type data structure containing the ingredients
|
||||
! for a local Jacobi iteration. The iterations are local to a process
|
||||
! (they operate on the block diagonal).
|
||||
!
|
||||
!
|
||||
module amg_c_jac_solver
|
||||
|
||||
use amg_c_base_solver_mod
|
||||
|
||||
type, extends(amg_c_base_solver_type) :: amg_c_jac_solver_type
|
||||
type(psb_cspmat_type) :: a
|
||||
type(psb_c_vect_type), allocatable :: dv
|
||||
complex(psb_spk_), allocatable :: d(:)
|
||||
integer(psb_ipk_) :: sweeps
|
||||
real(psb_spk_) :: eps
|
||||
contains
|
||||
procedure, pass(sv) :: dump => amg_c_jac_solver_dmp
|
||||
procedure, pass(sv) :: check => c_jac_solver_check
|
||||
procedure, pass(sv) :: clone => amg_c_jac_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_c_jac_solver_clone_settings
|
||||
procedure, pass(sv) :: clear_data => amg_c_jac_solver_clear_data
|
||||
procedure, pass(sv) :: build => amg_c_jac_solver_bld
|
||||
procedure, pass(sv) :: cnv => amg_c_jac_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_c_jac_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_c_jac_solver_apply
|
||||
procedure, pass(sv) :: free => c_jac_solver_free
|
||||
procedure, pass(sv) :: cseti => c_jac_solver_cseti
|
||||
procedure, pass(sv) :: csetc => c_jac_solver_csetc
|
||||
procedure, pass(sv) :: csetr => c_jac_solver_csetr
|
||||
procedure, pass(sv) :: descr => c_jac_solver_descr
|
||||
procedure, pass(sv) :: default => c_jac_solver_default
|
||||
procedure, pass(sv) :: sizeof => c_jac_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => c_jac_solver_get_nzeros
|
||||
procedure, nopass :: get_wrksz => c_jac_solver_get_wrksize
|
||||
procedure, nopass :: get_fmt => c_jac_solver_get_fmt
|
||||
procedure, nopass :: get_id => c_jac_solver_get_id
|
||||
procedure, nopass :: is_iterative => c_jac_solver_is_iterative
|
||||
end type amg_c_jac_solver_type
|
||||
|
||||
type, extends(amg_c_jac_solver_type) :: amg_c_l1_jac_solver_type
|
||||
contains
|
||||
procedure, pass(sv) :: build => amg_c_l1_jac_solver_bld
|
||||
procedure, pass(sv) :: descr => c_l1_jac_solver_descr
|
||||
procedure, nopass :: get_fmt => c_l1_jac_solver_get_fmt
|
||||
procedure, nopass :: get_id => c_l1_jac_solver_get_id
|
||||
end type amg_c_l1_jac_solver_type
|
||||
|
||||
|
||||
private :: c_jac_solver_bld, c_jac_solver_apply, &
|
||||
& c_jac_solver_free, &
|
||||
& c_jac_solver_descr, c_jac_solver_sizeof, &
|
||||
& c_jac_solver_default, c_jac_solver_dmp, &
|
||||
& c_jac_solver_apply_vect, c_jac_solver_get_nzeros, &
|
||||
& c_jac_solver_get_fmt, c_jac_solver_check,&
|
||||
& c_jac_solver_is_iterative, &
|
||||
& c_jac_solver_get_id, c_jac_solver_get_wrksize
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
type(psb_c_vect_type),intent(inout) :: x
|
||||
type(psb_c_vect_type),intent(inout) :: y
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
type(psb_c_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_c_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_c_jac_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
|
||||
import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
complex(psb_spk_),intent(inout) :: x(:)
|
||||
complex(psb_spk_),intent(inout) :: y(:)
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_spk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_c_jac_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_cspmat_type), intent(in), target, optional :: b
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_c_jac_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_c_l1_jac_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_l1_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_cspmat_type), intent(in), target, optional :: b
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_c_l1_jac_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_cnv(sv,info,amold,vmold,imold)
|
||||
import :: amg_c_jac_solver_type, psb_spk_, &
|
||||
& psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_c_jac_solver_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, &
|
||||
& psb_ipk_
|
||||
implicit none
|
||||
class(amg_c_jac_solver_type), intent(in) :: sv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: solver, global_num
|
||||
end subroutine amg_c_jac_solver_dmp
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_clone(sv,svout,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_base_solver_type, amg_c_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_jac_solver_clone
|
||||
end interface
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine amg_c_l1_jac_solver_clone(sv,svout,info)
|
||||
!!$ import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
!!$ & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
!!$ & amg_c_base_solver_type, amg_c_l1_jac_solver_type, psb_ipk_
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_c_l1_jac_solver_type), intent(inout) :: sv
|
||||
!!$ class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_c_l1_jac_solver_clone
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_base_solver_type, amg_c_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_jac_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_clear_data(sv,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_jac_solver_clear_data
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_jac_solver_default(sv)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%sweeps = ione
|
||||
sv%eps = dzero
|
||||
|
||||
return
|
||||
end subroutine c_jac_solver_default
|
||||
|
||||
subroutine c_jac_solver_check(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_jac_solver_check'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
call amg_check_def(sv%sweeps,&
|
||||
& 'Jacobi sweeps',ione,is_int_positive)
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine c_jac_solver_check
|
||||
|
||||
subroutine c_jac_solver_cseti(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_jac_solver_cseti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SOLVER_SWEEPS')
|
||||
sv%sweeps = val
|
||||
case default
|
||||
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_jac_solver_cseti
|
||||
|
||||
subroutine c_jac_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='c_jac_solver_csetc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_jac_solver_csetc
|
||||
|
||||
subroutine c_jac_solver_csetr(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_jac_solver_csetr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SOLVER_EPS')
|
||||
sv%eps = val
|
||||
case default
|
||||
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
|
||||
end select
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_jac_solver_csetr
|
||||
|
||||
subroutine c_jac_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_jac_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
call sv%a%free()
|
||||
if (allocated(sv%dv)) then
|
||||
call sv%dv%free(info)
|
||||
deallocate(sv%dv)
|
||||
end if
|
||||
if (allocated(sv%d)) deallocate(sv%d)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_jac_solver_free
|
||||
|
||||
subroutine c_jac_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_jac_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
iout_ = iout
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_jac_solver_descr
|
||||
|
||||
function c_jac_solver_get_nzeros(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = 0
|
||||
val = val + sv%a%get_nzeros()
|
||||
val = val + sv%dv%get_nrows()
|
||||
|
||||
return
|
||||
end function c_jac_solver_get_nzeros
|
||||
|
||||
function c_jac_solver_sizeof(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = psb_sizeof_ip
|
||||
val = val + sv%a%sizeof()
|
||||
val = val + sv%dv%sizeof()
|
||||
|
||||
return
|
||||
end function c_jac_solver_sizeof
|
||||
|
||||
function c_jac_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Jacobi solver"
|
||||
end function c_jac_solver_get_fmt
|
||||
|
||||
function c_jac_solver_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_jac_
|
||||
end function c_jac_solver_get_id
|
||||
|
||||
!
|
||||
! If this is true, then the solver needs a starting
|
||||
! guess. Currently only handled in JAC smoother.
|
||||
!
|
||||
function c_jac_solver_is_iterative() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function c_jac_solver_is_iterative
|
||||
|
||||
function c_jac_solver_get_wrksize() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = 2
|
||||
end function c_jac_solver_get_wrksize
|
||||
|
||||
subroutine c_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_l1_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_l1_jac_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
iout_ = iout
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_l1_jac_solver_descr
|
||||
|
||||
function c_l1_jac_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "L1-Jacobi solver"
|
||||
end function c_l1_jac_solver_get_fmt
|
||||
|
||||
function c_l1_jac_solver_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_l1_jac_
|
||||
end function c_l1_jac_solver_get_id
|
||||
|
||||
end module amg_c_jac_solver
|
||||
@@ -3,9 +3,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -21,7 +21,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -52,10 +52,10 @@
|
||||
!
|
||||
module amg_c_mumps_solver
|
||||
use amg_c_base_solver_mod
|
||||
#if defined(AMG_HAVE_MUMPS) && defined(AMG_HAVE_MUMPS_MODULES)
|
||||
#if defined(HAVE_MUMPS_) && defined(HAVE_MUMPS_MODULES_)
|
||||
use cmumps_struc_def
|
||||
#endif
|
||||
#if defined(AMG_HAVE_MUMPS) && defined(AMG_HAVE_MUMPS_INCLUDES)
|
||||
#if defined(HAVE_MUMPS_) && defined(HAVE_MUMPS_INCLUDES_)
|
||||
include 'cmumps_struc.h'
|
||||
#endif
|
||||
|
||||
@@ -68,7 +68,7 @@ module amg_c_mumps_solver
|
||||
end type amg_c_mumps_rcntl_item
|
||||
|
||||
type, extends(amg_c_base_solver_type) :: amg_c_mumps_solver_type
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
type(cmumps_struc), allocatable :: id
|
||||
#else
|
||||
integer, allocatable :: id
|
||||
@@ -78,8 +78,7 @@ module amg_c_mumps_solver
|
||||
!
|
||||
! Controls to be set before MUMPS instantiation:
|
||||
!
|
||||
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: 'LOCAL_SOLVER
|
||||
! 1==amg_global_solver_: 'GLOBAL_SOLVER'
|
||||
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: LOCAL 1==amg_global_solver_: GLOBAL
|
||||
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
|
||||
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
|
||||
integer(psb_ipk_), dimension(3) :: ipar
|
||||
@@ -163,7 +162,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
|
||||
@@ -189,7 +188,7 @@ contains
|
||||
|
||||
info = 0
|
||||
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -239,7 +238,7 @@ contains
|
||||
character(len=20) :: name='c_mumps_solver_clear_data'
|
||||
|
||||
info = 0
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
call psb_erractionsave(err_act)
|
||||
if (allocated(sv%id)) then
|
||||
if (sv%built) then
|
||||
@@ -279,7 +278,7 @@ contains
|
||||
character(len=20) :: name='c_mumps_solver_free'
|
||||
|
||||
info = 0
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
call psb_erractionsave(err_act)
|
||||
call sv%clear_data(info)
|
||||
if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
|
||||
@@ -314,24 +313,22 @@ subroutine c_mumps_solver_finalize(sv)
|
||||
|
||||
end subroutine c_mumps_solver_finalize
|
||||
|
||||
subroutine c_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_mumps_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_mumps_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: me, np
|
||||
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -340,13 +337,8 @@ subroutine c_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
|
||||
write(iout_,*) ' MUMPS Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -383,7 +375,7 @@ subroutine c_mumps_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
case('MUMPS_LOC_GLOB')
|
||||
sv%ipar(1) = sv%stringval(psb_toupper(trim(val)))
|
||||
#endif
|
||||
@@ -421,7 +413,7 @@ subroutine c_mumps_solver_cseti(sv,what,val,info,idx)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(what))
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
case('MUMPS_LOC_GLOB')
|
||||
sv%ipar(1) = val
|
||||
case('MUMPS_PRINT_ERR')
|
||||
@@ -467,7 +459,7 @@ subroutine c_mumps_solver_csetr(sv,what,val,info,idx)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(what))
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
case('MUMPS_RPAR_ENTRY')
|
||||
if(present(idx)) then
|
||||
! Note: this will allocate %item
|
||||
@@ -504,7 +496,7 @@ subroutine c_mumps_solver_default(sv)
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
if (.not.allocated(sv%id)) then
|
||||
allocate(sv%id,stat=info)
|
||||
if (info /= psb_success_) then
|
||||
@@ -561,7 +553,7 @@ function c_mumps_solver_sizeof(sv) result(val)
|
||||
class(amg_c_mumps_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer :: i
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
val = (sv%id%INFOG(22)+sv%id%INFOG(32))*1d+6
|
||||
#else
|
||||
val = 0
|
||||
|
||||
+392
-348
File diff suppressed because it is too large
Load Diff
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -40,7 +40,7 @@
|
||||
! Module: amg_c_prec_mod
|
||||
!
|
||||
! This module defines the user interfaces to the real/complex, single/double
|
||||
! precision versions of the user-level AMG4PSBLAS routines.
|
||||
! precision versions of the user-level MLD2P4 routines.
|
||||
!
|
||||
module amg_c_prec_mod
|
||||
|
||||
@@ -55,7 +55,12 @@ module amg_c_prec_mod
|
||||
use amg_c_ainv_solver
|
||||
use amg_c_invk_solver
|
||||
use amg_c_invt_solver
|
||||
use amg_c_krm_solver
|
||||
|
||||
interface amg_precset
|
||||
module procedure amg_c_iprecsetsm, amg_c_iprecsetsv, &
|
||||
& amg_c_cprecseti, amg_c_cprecsetc, amg_c_cprecsetr, &
|
||||
& amg_c_iprecsetag
|
||||
end interface amg_precset
|
||||
|
||||
interface amg_extprol_bld
|
||||
subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
|
||||
@@ -77,4 +82,61 @@ module amg_c_prec_mod
|
||||
end subroutine amg_c_extprol_bld
|
||||
end interface amg_extprol_bld
|
||||
|
||||
contains
|
||||
|
||||
subroutine amg_c_iprecsetsm(p,val,info,pos)
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
class(amg_c_base_smoother_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(val,info,pos=pos)
|
||||
end subroutine amg_c_iprecsetsm
|
||||
|
||||
subroutine amg_c_iprecsetsv(p,val,info,pos)
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
class(amg_c_base_solver_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
call p%set(val,info, pos=pos)
|
||||
end subroutine amg_c_iprecsetsv
|
||||
|
||||
subroutine amg_c_iprecsetag(p,val,info,pos)
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
class(amg_c_base_aggregator_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
call p%set(val,info, pos=pos)
|
||||
end subroutine amg_c_iprecsetag
|
||||
|
||||
subroutine amg_c_cprecseti(p,what,val,info,pos)
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_c_cprecseti
|
||||
|
||||
subroutine amg_c_cprecsetr(p,what,val,info,pos)
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_c_cprecsetr
|
||||
|
||||
subroutine amg_c_cprecsetc(p,what,val,info,pos)
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_c_cprecsetc
|
||||
|
||||
end module amg_c_prec_mod
|
||||
|
||||
+51
-166
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -66,7 +66,7 @@ module amg_c_prec_type
|
||||
!
|
||||
! This is the data type containing all the information about the multilevel
|
||||
! preconditioner ('d', 's', 'c' and 'z', according to the real/complex,
|
||||
! single/double precision version of AMG4PSBLAS).
|
||||
! single/double precision version of MLD2P4).
|
||||
! It consists of an array of 'one-level' intermediate data structures
|
||||
! of type amg_conelev_type, each containing the information needed to apply
|
||||
! the smoothing and the coarse-space correction at a generic level. RT is the
|
||||
@@ -102,7 +102,6 @@ module amg_c_prec_type
|
||||
! The multilevel hierarchy
|
||||
!
|
||||
type(amg_c_onelev_type), allocatable :: precv(:)
|
||||
integer(psb_ipk_) :: nlevs
|
||||
contains
|
||||
procedure, pass(prec) :: psb_c_apply2_vect => amg_c_apply2_vect
|
||||
procedure, pass(prec) :: psb_c_apply1_vect => amg_c_apply1_vect
|
||||
@@ -114,13 +113,11 @@ module amg_c_prec_type
|
||||
procedure, pass(prec) :: free => amg_c_prec_free
|
||||
procedure, pass(prec) :: allocate_wrk => amg_c_allocate_wrk
|
||||
procedure, pass(prec) :: free_wrk => amg_c_free_wrk
|
||||
procedure, pass(prec) :: deallocate_wrk => amg_c_free_wrk
|
||||
procedure, pass(prec) :: is_allocated_wrk => amg_c_is_allocated_wrk
|
||||
procedure, pass(prec) :: get_complexity => amg_c_get_compl
|
||||
procedure, pass(prec) :: cmp_complexity => amg_c_cmp_compl
|
||||
procedure, pass(prec) :: get_avg_cr => amg_c_get_avg_cr
|
||||
procedure, pass(prec) :: cmp_avg_cr => amg_c_cmp_avg_cr
|
||||
procedure, pass(prec) :: set_nlevs => amg_c_set_nlevs
|
||||
procedure, pass(prec) :: get_nlevs => amg_c_get_nlevs
|
||||
procedure, pass(prec) :: get_nzeros => amg_c_get_nzeros
|
||||
procedure, pass(prec) :: sizeof => amg_cprec_sizeof
|
||||
@@ -138,11 +135,8 @@ module amg_c_prec_type
|
||||
procedure, pass(prec) :: build => amg_cprecbld
|
||||
procedure, pass(prec) :: hierarchy_build => amg_c_hierarchy_bld
|
||||
procedure, pass(prec) :: hierarchy_rebuild => amg_c_hierarchy_rebld
|
||||
procedure, pass(prec) :: hierarchy_free => amg_c_hierarchy_free
|
||||
procedure, pass(prec) :: smoothers_build => amg_c_smoothers_bld
|
||||
procedure, pass(prec) :: smoothers_free => amg_c_smoothers_free
|
||||
procedure, pass(prec) :: descr => amg_cfile_prec_descr
|
||||
procedure, pass(prec) :: memory_use => amg_cfile_prec_memory_use
|
||||
end type amg_cprec_type
|
||||
|
||||
private :: amg_c_dump, amg_c_get_compl, amg_c_cmp_compl,&
|
||||
@@ -161,35 +155,16 @@ module amg_c_prec_type
|
||||
|
||||
|
||||
interface amg_precdescr
|
||||
subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity,prefix)
|
||||
subroutine amg_cfile_prec_descr(prec,iout,root)
|
||||
import :: amg_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_cfile_prec_descr
|
||||
end interface
|
||||
|
||||
|
||||
interface amg_memory_use
|
||||
subroutine amg_cfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
|
||||
import :: amg_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: global
|
||||
end subroutine amg_cfile_prec_memory_use
|
||||
end interface
|
||||
|
||||
interface amg_sizeof
|
||||
module procedure amg_cprec_sizeof
|
||||
end interface
|
||||
@@ -313,7 +288,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
|
||||
@@ -325,15 +300,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
|
||||
@@ -368,14 +342,6 @@ module amg_c_prec_type
|
||||
end subroutine amg_c_smoothers_bld
|
||||
end interface amg_smoothers_bld
|
||||
|
||||
interface amg_smoothers_free
|
||||
module procedure amg_c_smoothers_free
|
||||
end interface amg_smoothers_free
|
||||
|
||||
interface amg_hierarchy_free
|
||||
module procedure amg_c_hierarchy_free
|
||||
end interface amg_hierarchy_free
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -437,19 +403,10 @@ contains
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_) :: val
|
||||
val = 0
|
||||
!!$ if (allocated(prec%precv)) then
|
||||
!!$ val = size(prec%precv)
|
||||
!!$ end if
|
||||
val = prec%nlevs
|
||||
!!$ write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
|
||||
if (allocated(prec%precv)) then
|
||||
val = size(prec%precv)
|
||||
end if
|
||||
end function amg_c_get_nlevs
|
||||
|
||||
subroutine amg_c_set_nlevs(prec,nl)
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_) :: nl
|
||||
prec%nlevs = nl
|
||||
end subroutine amg_c_set_nlevs
|
||||
!
|
||||
! Function returning the size of the amg_prec_type data structure
|
||||
! in bytes or in number of nonzeros of the operator(s) involved.
|
||||
@@ -467,22 +424,11 @@ contains
|
||||
end if
|
||||
end function amg_c_get_nzeros
|
||||
|
||||
function amg_cprec_sizeof(prec, global) result(val)
|
||||
function amg_cprec_sizeof(prec) result(val)
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
logical, intent(in), optional :: global
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
|
||||
logical :: global_
|
||||
|
||||
if (present(global)) then
|
||||
global_ = global
|
||||
else
|
||||
global_ = .false.
|
||||
end if
|
||||
|
||||
val = 0
|
||||
val = val + psb_sizeof_ip
|
||||
if (allocated(prec%precv)) then
|
||||
@@ -490,11 +436,6 @@ contains
|
||||
val = val + prec%precv(i)%sizeof()
|
||||
end do
|
||||
end if
|
||||
if (global_) then
|
||||
ctxt = prec%ctxt
|
||||
call psb_sum(ctxt,val)
|
||||
end if
|
||||
|
||||
end function amg_cprec_sizeof
|
||||
|
||||
!
|
||||
@@ -520,7 +461,7 @@ contains
|
||||
|
||||
real(psb_spk_) :: num, den, nmin
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: il,nl
|
||||
integer(psb_ipk_) :: il
|
||||
|
||||
num = -sone
|
||||
den = sone
|
||||
@@ -530,10 +471,7 @@ contains
|
||||
num = prec%precv(il)%base_a%get_nzeros()
|
||||
if (num >= szero) then
|
||||
den = num
|
||||
nl = prec%get_nlevs()
|
||||
!!$ write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
|
||||
do il=2, nl
|
||||
!!$ write(0,*) ' ',il,associated(prec%precv(il)%base_a)
|
||||
do il=2,size(prec%precv)
|
||||
num = num + max(0,prec%precv(il)%base_a%get_nzeros())
|
||||
end do
|
||||
end if
|
||||
@@ -564,6 +502,7 @@ contains
|
||||
end function amg_c_get_avg_cr
|
||||
|
||||
subroutine amg_c_cmp_avg_cr(prec)
|
||||
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
|
||||
@@ -571,18 +510,17 @@ contains
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: il, nl, iam, np
|
||||
|
||||
|
||||
avgcr = szero
|
||||
nl = prec%get_nlevs()
|
||||
do il=2,nl
|
||||
if (prec%precv(il)%base_desc%is_ok()) then
|
||||
ctxt = prec%precv(il)%base_desc%get_ctxt()
|
||||
call psb_info(ctxt,iam,np)
|
||||
if (iam >=0) avgcr = avgcr + max(szero,prec%precv(il)%szratio)
|
||||
end if
|
||||
end do
|
||||
avgcr = avgcr / (nl-1)
|
||||
ctxt = prec%ctxt
|
||||
call psb_info(ctxt,iam,np)
|
||||
if (allocated(prec%precv)) then
|
||||
nl = size(prec%precv)
|
||||
do il=2,nl
|
||||
avgcr = avgcr + max(szero,prec%precv(il)%szratio)
|
||||
end do
|
||||
avgcr = avgcr / (nl-1)
|
||||
end if
|
||||
call psb_sum(ctxt,avgcr)
|
||||
prec%ag_data%avg_cr = avgcr/np
|
||||
end subroutine amg_c_cmp_avg_cr
|
||||
@@ -600,7 +538,9 @@ contains
|
||||
! error code.
|
||||
!
|
||||
subroutine amg_cprecfree(p,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -626,7 +566,9 @@ contains
|
||||
end subroutine amg_cprecfree
|
||||
|
||||
subroutine amg_c_prec_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -646,11 +588,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
|
||||
@@ -662,64 +599,7 @@ contains
|
||||
|
||||
end subroutine amg_c_prec_free
|
||||
|
||||
subroutine amg_c_smoothers_free(prec,info)
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_c_smoothers_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,prec%get_nlevs()
|
||||
call prec%precv(i)%free_smoothers(info)
|
||||
end do
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_c_smoothers_free
|
||||
|
||||
subroutine amg_c_hierarchy_free(prec,info)
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_c_hierarchy_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
me=-1
|
||||
write(0,*) 'Missing implementation '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_c_hierarchy_free
|
||||
|
||||
!
|
||||
! Top level methods.
|
||||
@@ -785,6 +665,7 @@ contains
|
||||
|
||||
end subroutine amg_c_apply1_vect
|
||||
|
||||
|
||||
subroutine amg_c_apply2v(prec,x,y,desc_data,info,trans,work)
|
||||
implicit none
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
@@ -849,6 +730,7 @@ contains
|
||||
subroutine amg_c_dump(prec,info,istart,iend,iproc,prefix,head,&
|
||||
& ac,rp,smoother,solver,tprol,&
|
||||
& global_num)
|
||||
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -856,16 +738,17 @@ contains
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
|
||||
integer(psb_ipk_) :: i, j, il1, iln, lev
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
type(psb_ctxt_type) :: icontxt
|
||||
integer(psb_ipk_) :: iam, np, iproc_
|
||||
character(len=80) :: prefix_
|
||||
character(len=120) :: fname ! len should be at least 20 more than
|
||||
! len of prefix_
|
||||
|
||||
info = 0
|
||||
ctxt = prec%ctxt
|
||||
call psb_info(ctxt,iam,np)
|
||||
iln = prec%get_nlevs()
|
||||
icontxt = prec%ctxt
|
||||
call psb_info(icontxt,iam,np)
|
||||
|
||||
iln = size(prec%precv)
|
||||
if (present(istart)) then
|
||||
il1 = max(1,istart)
|
||||
else
|
||||
@@ -889,6 +772,7 @@ contains
|
||||
end subroutine amg_c_dump
|
||||
|
||||
subroutine amg_c_cnv(prec,info,amold,vmold,imold)
|
||||
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -900,7 +784,7 @@ contains
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,prec%get_nlevs()
|
||||
do i=1,size(prec%precv)
|
||||
if (info == psb_success_ ) &
|
||||
& call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
|
||||
end do
|
||||
@@ -909,6 +793,7 @@ contains
|
||||
end subroutine amg_c_cnv
|
||||
|
||||
subroutine amg_c_clone(prec,precout,info)
|
||||
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
class(psb_cprec_type), intent(inout) :: precout
|
||||
@@ -920,24 +805,24 @@ contains
|
||||
end subroutine amg_c_clone
|
||||
|
||||
subroutine amg_c_inner_clone(prec,precout,info)
|
||||
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
class(psb_cprec_type), target, intent(inout) :: precout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
! Local vars
|
||||
integer(psb_ipk_) :: i, j, ln, lev
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
type(psb_ctxt_type) :: icontxt
|
||||
integer(psb_ipk_) :: iam, np
|
||||
|
||||
info = psb_success_
|
||||
select type(pout => precout)
|
||||
class is (amg_cprec_type)
|
||||
pout%ctxt = prec%ctxt
|
||||
pout%ctxt = prec%ctxt
|
||||
pout%ag_data = prec%ag_data
|
||||
pout%outer_sweeps = prec%outer_sweeps
|
||||
pout%nlevs = prec%nlevs
|
||||
if (allocated(prec%precv)) then
|
||||
ln = prec%get_nlevs()
|
||||
ln = size(prec%precv)
|
||||
allocate(pout%precv(ln),stat=info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (ln >= 1) then
|
||||
@@ -945,13 +830,12 @@ contains
|
||||
end if
|
||||
do lev=2, ln
|
||||
if (info /= psb_success_) exit
|
||||
!!$ write(0,*) 'Inner_clone must be checked and reimplemented! '
|
||||
call prec%precv(lev)%clone(pout%precv(lev),info)
|
||||
if (info == psb_success_) then
|
||||
pout%precv(lev)%base_a => pout%precv(lev)%ac
|
||||
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
|
||||
pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
|
||||
pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
|
||||
pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
|
||||
pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
@@ -991,8 +875,8 @@ contains
|
||||
do i=2, size(b%precv)
|
||||
b%precv(i)%base_a => b%precv(i)%ac
|
||||
b%precv(i)%base_desc => b%precv(i)%desc_ac
|
||||
b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
|
||||
b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
|
||||
b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
|
||||
b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
|
||||
end do
|
||||
|
||||
else
|
||||
@@ -1010,7 +894,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
|
||||
@@ -1025,7 +909,7 @@ contains
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
nlev = prec%get_nlevs()
|
||||
nlev = size(prec%precv)
|
||||
level = 1
|
||||
do level = 1, nlev
|
||||
call prec%precv(level)%allocate_wrk(info,vmold=vmold)
|
||||
@@ -1048,6 +932,7 @@ contains
|
||||
subroutine amg_c_free_wrk(prec,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -1064,7 +949,7 @@ contains
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
nlev = prec%get_nlevs()
|
||||
nlev = size(prec%precv)
|
||||
do level = 1, nlev
|
||||
call prec%precv(level)%free_wrk(info)
|
||||
end do
|
||||
|
||||
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
@@ -23,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -55,14 +52,14 @@
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! 3. The name of the MLD2P4 group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific prior written permission.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
|
||||
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
|
||||
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
@@ -73,16 +70,16 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_c_krm_solver_mod.f90
|
||||
! File: amg_c_rkr_solver_mod.f90
|
||||
!
|
||||
! Module: amg_c_krm_solver_mod
|
||||
! Module: amg_c_rkr_solver_mod
|
||||
!
|
||||
module amg_c_krm_solver
|
||||
module amg_c_rkr_solver
|
||||
|
||||
use amg_c_base_solver_mod
|
||||
use amg_c_prec_type
|
||||
|
||||
type, extends(amg_c_base_solver_type) :: amg_c_krm_solver_type
|
||||
type, extends(amg_c_base_solver_type) :: amg_c_rkr_solver_type
|
||||
!
|
||||
logical :: global
|
||||
character(len=16) :: method, kprec, sub_solve
|
||||
@@ -97,46 +94,46 @@ module amg_c_krm_solver
|
||||
contains
|
||||
!
|
||||
!
|
||||
procedure, pass(sv) :: dump => c_krm_solver_dmp
|
||||
procedure, pass(sv) :: check => c_krm_solver_check
|
||||
procedure, pass(sv) :: clone => c_krm_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => c_krm_solver_clone_settings
|
||||
procedure, pass(sv) :: cnv => c_krm_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_c_krm_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_c_krm_solver_apply
|
||||
procedure, pass(sv) :: clear_data => c_krm_solver_clear_data
|
||||
procedure, pass(sv) :: free => c_krm_solver_free
|
||||
procedure, pass(sv) :: cseti => c_krm_solver_cseti
|
||||
procedure, pass(sv) :: csetc => c_krm_solver_csetc
|
||||
procedure, pass(sv) :: csetr => c_krm_solver_csetr
|
||||
procedure, pass(sv) :: sizeof => c_krm_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => c_krm_solver_get_nzeros
|
||||
!procedure, nopass :: get_id => c_krm_solver_get_id
|
||||
procedure, pass(sv) :: is_global => c_krm_solver_is_global
|
||||
procedure, nopass :: is_iterative => c_krm_solver_is_iterative
|
||||
procedure, pass(sv) :: dump => c_rkr_solver_dmp
|
||||
procedure, pass(sv) :: check => c_rkr_solver_check
|
||||
procedure, pass(sv) :: clone => c_rkr_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => c_rkr_solver_clone_settings
|
||||
procedure, pass(sv) :: cnv => c_rkr_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_c_rkr_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_c_rkr_solver_apply
|
||||
procedure, pass(sv) :: clear_data => c_rkr_solver_clear_data
|
||||
procedure, pass(sv) :: free => c_rkr_solver_free
|
||||
procedure, pass(sv) :: cseti => c_rkr_solver_cseti
|
||||
procedure, pass(sv) :: csetc => c_rkr_solver_csetc
|
||||
procedure, pass(sv) :: csetr => c_rkr_solver_csetr
|
||||
procedure, pass(sv) :: sizeof => c_rkr_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => c_rkr_solver_get_nzeros
|
||||
!procedure, nopass :: get_id => c_rkr_solver_get_id
|
||||
procedure, pass(sv) :: is_global => c_rkr_solver_is_global
|
||||
procedure, nopass :: is_iterative => c_rkr_solver_is_iterative
|
||||
|
||||
|
||||
!
|
||||
! These methods are specific for the new solver type
|
||||
! and therefore need to be overridden
|
||||
!
|
||||
procedure, pass(sv) :: descr => c_krm_solver_descr
|
||||
procedure, pass(sv) :: default => c_krm_solver_default
|
||||
procedure, pass(sv) :: build => amg_c_krm_solver_bld
|
||||
procedure, nopass :: get_fmt => c_krm_solver_get_fmt
|
||||
end type amg_c_krm_solver_type
|
||||
procedure, pass(sv) :: descr => c_rkr_solver_descr
|
||||
procedure, pass(sv) :: default => c_rkr_solver_default
|
||||
procedure, pass(sv) :: build => amg_c_rkr_solver_bld
|
||||
procedure, nopass :: get_fmt => c_rkr_solver_get_fmt
|
||||
end type amg_c_rkr_solver_type
|
||||
|
||||
|
||||
private :: c_krm_solver_get_fmt, c_krm_solver_descr, c_krm_solver_default
|
||||
private :: c_rkr_solver_get_fmt, c_rkr_solver_descr, c_rkr_solver_default
|
||||
|
||||
interface
|
||||
subroutine amg_c_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
subroutine amg_c_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
import :: psb_desc_type, amg_c_rkr_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
type(psb_c_vect_type),intent(inout) :: x
|
||||
type(psb_c_vect_type),intent(inout) :: y
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
@@ -146,17 +143,17 @@ module amg_c_krm_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_c_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_c_krm_solver_apply_vect
|
||||
end subroutine amg_c_rkr_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
subroutine amg_c_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
import :: psb_desc_type, amg_c_rkr_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
complex(psb_spk_),intent(inout) :: x(:)
|
||||
complex(psb_spk_),intent(inout) :: y(:)
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
@@ -165,24 +162,24 @@ module amg_c_krm_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_spk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_c_krm_solver_apply
|
||||
end subroutine amg_c_rkr_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
subroutine amg_c_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_c_rkr_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(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
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_cspmat_type), intent(in), target, optional :: b
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_c_krm_solver_bld
|
||||
end subroutine amg_c_rkr_solver_bld
|
||||
end interface
|
||||
|
||||
|
||||
@@ -190,12 +187,12 @@ contains
|
||||
|
||||
!
|
||||
!
|
||||
subroutine c_krm_solver_default(sv)
|
||||
subroutine c_rkr_solver_default(sv)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%method = 'bicgstab'
|
||||
sv%kprec = 'bjac'
|
||||
@@ -210,42 +207,42 @@ contains
|
||||
sv%global = .false.
|
||||
|
||||
return
|
||||
end subroutine c_krm_solver_default
|
||||
end subroutine c_rkr_solver_default
|
||||
|
||||
function c_krm_solver_get_nzeros(sv) result(val)
|
||||
function c_rkr_solver_get_nzeros(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_c_krm_solver_type), intent(in) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = sv%prec%get_nzeros()
|
||||
|
||||
return
|
||||
end function c_krm_solver_get_nzeros
|
||||
end function c_rkr_solver_get_nzeros
|
||||
|
||||
function c_krm_solver_sizeof(sv) result(val)
|
||||
function c_rkr_solver_sizeof(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_c_krm_solver_type), intent(in) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
|
||||
|
||||
return
|
||||
end function c_krm_solver_sizeof
|
||||
end function c_rkr_solver_sizeof
|
||||
|
||||
|
||||
subroutine c_krm_solver_check(sv,info)
|
||||
subroutine c_rkr_solver_check(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_krm_solver_check'
|
||||
character(len=20) :: name='c_rkr_solver_check'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -259,36 +256,36 @@ contains
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine c_krm_solver_check
|
||||
end subroutine c_rkr_solver_check
|
||||
|
||||
subroutine c_krm_solver_cseti(sv,what,val,info,idx)
|
||||
subroutine c_rkr_solver_cseti(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_krm_solver_cseti'
|
||||
character(len=20) :: name='c_rkr_solver_cseti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('KRM_IRST')
|
||||
case('RKR_IRST')
|
||||
sv%irst = val
|
||||
case('KRM_ISTOPC')
|
||||
case('RKR_ISTOPC')
|
||||
sv%istopc = val
|
||||
case('KRM_ITMAX')
|
||||
case('RKR_ITMAX')
|
||||
sv%itmax = val
|
||||
case('KRM_ITRACE')
|
||||
case('RKR_ITRACE')
|
||||
sv%itrace = val
|
||||
case('KRM_SUB_SOLVE')
|
||||
case('RKR_SUB_SOLVE')
|
||||
sv%i_sub_solve = val
|
||||
case('KRM_FILLIN')
|
||||
case('RKR_FILLIN')
|
||||
sv%fillin = val
|
||||
case default
|
||||
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
|
||||
@@ -299,33 +296,33 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_krm_solver_cseti
|
||||
end subroutine c_rkr_solver_cseti
|
||||
|
||||
subroutine c_krm_solver_csetc(sv,what,val,info,idx)
|
||||
subroutine c_rkr_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='c_krm_solver_csetc'
|
||||
character(len=20) :: name='c_rkr_solver_csetc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('KRM_METHOD')
|
||||
case('RKR_METHOD')
|
||||
sv%method = psb_toupper(trim(val))
|
||||
case('KRM_KPREC')
|
||||
case('RKR_KPREC')
|
||||
sv%kprec = psb_toupper(trim(val))
|
||||
case('KRM_SUB_SOLVE')
|
||||
case('RKR_SUB_SOLVE')
|
||||
sv%sub_solve = psb_toupper(trim(val))
|
||||
case('KRM_GLOBAL')
|
||||
case('RKR_GLOBAL')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('LOCAL','FALSE')
|
||||
sv%global = .false.
|
||||
@@ -348,26 +345,26 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_krm_solver_csetc
|
||||
end subroutine c_rkr_solver_csetc
|
||||
|
||||
subroutine c_krm_solver_csetr(sv,what,val,info,idx)
|
||||
subroutine c_rkr_solver_csetr(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_krm_solver_csetr'
|
||||
character(len=20) :: name='c_rkr_solver_csetr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('KRM_EPS')
|
||||
case('RKR_EPS')
|
||||
sv%eps = val
|
||||
case default
|
||||
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
|
||||
@@ -378,18 +375,18 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_krm_solver_csetr
|
||||
end subroutine c_rkr_solver_csetr
|
||||
|
||||
subroutine c_krm_solver_clear_data(sv,info)
|
||||
subroutine c_rkr_solver_clear_data(sv,info)
|
||||
use psb_base_mod, only : psb_exit
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: l_ctxt
|
||||
character(len=20) :: name='c_krm_solver_free'
|
||||
character(len=20) :: name='c_rkr_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -406,19 +403,19 @@ contains
|
||||
nullify(sv%a)
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
end subroutine c_krm_solver_clear_data
|
||||
end subroutine c_rkr_solver_clear_data
|
||||
|
||||
|
||||
subroutine c_krm_solver_free(sv,info)
|
||||
subroutine c_rkr_solver_free(sv,info)
|
||||
use psb_base_mod, only : psb_exit
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: l_ctxt
|
||||
character(len=20) :: name='c_krm_solver_free'
|
||||
character(len=20) :: name='c_rkr_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -427,31 +424,29 @@ contains
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
end subroutine c_krm_solver_free
|
||||
end subroutine c_rkr_solver_free
|
||||
|
||||
function c_krm_solver_get_fmt() result(val)
|
||||
function c_rkr_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "KRM solver"
|
||||
end function c_krm_solver_get_fmt
|
||||
val = "RKR solver"
|
||||
end function c_rkr_solver_get_fmt
|
||||
|
||||
subroutine c_krm_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_rkr_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_krm_solver_type), intent(in) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_krm_solver_descr'
|
||||
character(len=20), parameter :: name='amg_c_rkr_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -460,33 +455,34 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%global) then
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
|
||||
write(iout_,*) ' Recursive Krylov solver (global)'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
|
||||
write(iout_,*) ' Recursive Krylov solver (local) '
|
||||
end if
|
||||
write(iout_,*) trim(prefix_), ' method: ',sv%method
|
||||
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
|
||||
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
|
||||
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
|
||||
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
|
||||
write(iout_,*) ' method: ',sv%method
|
||||
write(iout_,*) ' kprec: ',sv%kprec
|
||||
if (sv%i_sub_solve > 0) then
|
||||
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
|
||||
else
|
||||
write(iout_,*) ' sub_solve: ',sv%sub_solve
|
||||
end if
|
||||
write(iout_,*) ' itmax: ',sv%itmax
|
||||
write(iout_,*) ' eps: ',sv%eps
|
||||
write(iout_,*) ' fillin: ',sv%fillin
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_krm_solver_descr
|
||||
end subroutine c_rkr_solver_descr
|
||||
|
||||
subroutine c_krm_solver_cnv(sv,info,amold,vmold,imold)
|
||||
subroutine c_rkr_solver_cnv(sv,info,amold,vmold,imold)
|
||||
implicit none
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
@@ -494,13 +490,13 @@ contains
|
||||
|
||||
call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
|
||||
|
||||
end subroutine c_krm_solver_cnv
|
||||
end subroutine c_rkr_solver_cnv
|
||||
|
||||
subroutine c_krm_solver_clone(sv,svout,info)
|
||||
subroutine c_rkr_solver_clone(sv,svout,info)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -509,7 +505,7 @@ contains
|
||||
call svout%free(info)
|
||||
allocate(svout,stat=info,mold=sv)
|
||||
select type(so=>svout)
|
||||
class is(amg_c_krm_solver_type)
|
||||
class is(amg_c_rkr_solver_type)
|
||||
so%method = sv%method
|
||||
so%kprec = sv%kprec
|
||||
so%sub_solve = sv%sub_solve
|
||||
@@ -528,21 +524,21 @@ contains
|
||||
info = psb_err_internal_error_
|
||||
end select
|
||||
|
||||
end subroutine c_krm_solver_clone
|
||||
end subroutine c_rkr_solver_clone
|
||||
|
||||
|
||||
subroutine c_krm_solver_clone_settings(sv,svout,info)
|
||||
subroutine c_rkr_solver_clone_settings(sv,svout,info)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type(so=>svout)
|
||||
class is(amg_c_krm_solver_type)
|
||||
class is(amg_c_rkr_solver_type)
|
||||
so%method = sv%method
|
||||
so%kprec = sv%kprec
|
||||
so%sub_solve = sv%sub_solve
|
||||
@@ -558,11 +554,11 @@ contains
|
||||
info = psb_err_internal_error_
|
||||
end select
|
||||
|
||||
end subroutine c_krm_solver_clone_settings
|
||||
end subroutine c_rkr_solver_clone_settings
|
||||
|
||||
subroutine c_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
subroutine c_rkr_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
implicit none
|
||||
class(amg_c_krm_solver_type), intent(in) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(in) :: sv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -572,23 +568,23 @@ contains
|
||||
|
||||
call sv%prec%dump(info,prefix=prefix,head=head)
|
||||
|
||||
end subroutine c_krm_solver_dmp
|
||||
end subroutine c_rkr_solver_dmp
|
||||
!
|
||||
! Notify whether KRM is used as a global solver
|
||||
! Notify whether RKR is used as a global solver
|
||||
!
|
||||
function c_krm_solver_is_global(sv) result(val)
|
||||
function c_rkr_solver_is_global(sv) result(val)
|
||||
implicit none
|
||||
class(amg_c_krm_solver_type), intent(in) :: sv
|
||||
class(amg_c_rkr_solver_type), intent(in) :: sv
|
||||
logical :: val
|
||||
|
||||
val = (sv%global)
|
||||
end function c_krm_solver_is_global
|
||||
end function c_rkr_solver_is_global
|
||||
!
|
||||
function c_krm_solver_is_iterative() result(val)
|
||||
function c_rkr_solver_is_iterative() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function c_krm_solver_is_iterative
|
||||
end function c_rkr_solver_is_iterative
|
||||
|
||||
end module amg_c_krm_solver
|
||||
end module amg_c_rkr_solver
|
||||
+214
-277
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -51,7 +51,7 @@ module amg_c_slu_solver
|
||||
use iso_c_binding
|
||||
use amg_c_base_solver_mod
|
||||
|
||||
#if defined(PSB_IPK8)
|
||||
#if defined(IPK8)
|
||||
|
||||
type, extends(amg_c_base_solver_type) :: amg_c_slu_solver_type
|
||||
|
||||
@@ -63,9 +63,9 @@ module amg_c_slu_solver
|
||||
type(c_ptr) :: lufactors=c_null_ptr
|
||||
integer(c_long_long) :: symbsize=0, numsize=0
|
||||
contains
|
||||
procedure, pass(sv) :: build => amg_c_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => amg_c_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => amg_c_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: build => c_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => c_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => c_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: free => c_slu_solver_free
|
||||
procedure, pass(sv) :: clear_data => c_slu_solver_clear_data
|
||||
procedure, pass(sv) :: descr => c_slu_solver_descr
|
||||
@@ -76,8 +76,9 @@ module amg_c_slu_solver
|
||||
end type amg_c_slu_solver_type
|
||||
|
||||
|
||||
private :: c_slu_solver_free, c_slu_solver_descr, &
|
||||
& c_slu_solver_sizeof, &
|
||||
private :: c_slu_solver_bld, c_slu_solver_apply, &
|
||||
& c_slu_solver_free, c_slu_solver_descr, &
|
||||
& c_slu_solver_sizeof, c_slu_solver_apply_vect, &
|
||||
& c_slu_solver_get_fmt, c_slu_solver_get_id, &
|
||||
& c_slu_solver_clear_data
|
||||
private :: c_slu_solver_finalize
|
||||
@@ -117,264 +118,207 @@ module amg_c_slu_solver
|
||||
end function amg_cslu_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
import amg_c_slu_solver_type
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(inout), 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
|
||||
type(psb_cspmat_type), intent(in), target, optional :: b
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_c_slu_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_c_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_c_vect_type),intent(inout) :: x
|
||||
type(psb_c_vect_type),intent(inout) :: y
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
type(psb_c_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_c_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_c_slu_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_c_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
complex(psb_spk_),intent(inout) :: x(:)
|
||||
complex(psb_spk_),intent(inout) :: y(:)
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_spk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_c_slu_solver_apply
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
!!$ subroutine c_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
!!$ complex(psb_spk_),intent(inout) :: x(:)
|
||||
!!$ complex(psb_spk_),intent(inout) :: y(:)
|
||||
!!$ complex(psb_spk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ complex(psb_spk_),intent(inout), optional :: initu(:)
|
||||
!!$
|
||||
!!$ integer :: n_row,n_col
|
||||
!!$ complex(psb_spk_), pointer :: ww(:)
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act
|
||||
!!$ character :: trans_
|
||||
!!$ character(len=20) :: name='c_slu_solver_apply'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$
|
||||
!!$ trans_ = psb_toupper(trans)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ case('T','C')
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ n_row = desc_data%get_local_rows()
|
||||
!!$ n_col = desc_data%get_local_cols()
|
||||
!!$
|
||||
!!$ if (n_col <= size(work)) then
|
||||
!!$ ww => work(1:n_col)
|
||||
!!$ else
|
||||
!!$ allocate(ww(n_col),stat=info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_alloc_request_
|
||||
!!$ call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
!!$ & a_err='complex(psb_spk_)')
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ ww(1:n_row) = x(1:n_row)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ info = amg_cslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('T')
|
||||
!!$ info = amg_cslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('C')
|
||||
!!$ info = amg_cslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_internal_error_, &
|
||||
!!$ & name,a_err='Invalid TRANS in ILU subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$
|
||||
!!$ if (info == psb_success_) &
|
||||
!!$ & call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
!!$
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ call psb_errpush(psb_err_internal_error_,&
|
||||
!!$ & name,a_err='Error in subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ if (n_col > size(work)) then
|
||||
!!$ deallocate(ww)
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine c_slu_solver_apply
|
||||
!!$
|
||||
!!$ subroutine c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,wv,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
!!$ type(psb_c_vect_type),intent(inout) :: x
|
||||
!!$ type(psb_c_vect_type),intent(inout) :: y
|
||||
!!$ complex(psb_spk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
!!$ type(psb_c_vect_type),intent(inout) :: wv(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ type(psb_c_vect_type),intent(inout), optional :: initu
|
||||
!!$
|
||||
!!$ integer :: err_act
|
||||
!!$ character(len=20) :: name='c_slu_solver_apply_vect'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ call x%v%sync()
|
||||
!!$ call y%v%sync()
|
||||
!!$ call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
!!$ call y%v%set_host()
|
||||
!!$ if (info /= 0) goto 9999
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine c_slu_solver_apply_vect
|
||||
!!$
|
||||
!!$ subroutine c_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
!!$
|
||||
!!$ use psb_base_mod
|
||||
!!$
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ 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, intent(out) :: info
|
||||
!!$ type(psb_cspmat_type), intent(in), target, optional :: b
|
||||
!!$ class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
!!$ class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
!!$ class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
!!$ ! Local variables
|
||||
!!$ type(psb_cspmat_type) :: atmp
|
||||
!!$ type(psb_c_csc_sparse_mat) :: acsc
|
||||
!!$ type(psb_c_coo_sparse_mat) :: acoo
|
||||
!!$ integer :: n_row,n_col, nrow_a, nztota
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
!!$ character(len=20) :: name='c_slu_solver_bld', ch_err
|
||||
!!$
|
||||
!!$ info=psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ debug_unit = psb_get_debug_unit()
|
||||
!!$ debug_level = psb_get_debug_level()
|
||||
!!$ ctxt = desc_a%get_context()
|
||||
!!$ call psb_info(ctxt, me, np)
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' start'
|
||||
!!$
|
||||
!!$
|
||||
!!$ n_row = desc_a%get_local_rows()
|
||||
!!$ n_col = desc_a%get_local_cols()
|
||||
!!$
|
||||
!!$
|
||||
!!$ call a%cscnv(atmp,info,type='coo')
|
||||
!!$ call psb_rwextd(n_row,atmp,info,b=b)
|
||||
!!$ call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
!!$ nrow_a = atmp%get_nrows()
|
||||
!!$ call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
!!$ call acsc%mv_from_coo(acoo,info)
|
||||
!!$ nztota = acsc%get_nzeros()
|
||||
!!$ ! Fix the entries to call C-base SuperLU
|
||||
!!$ acsc%ia(:) = acsc%ia(:) - 1
|
||||
!!$ acsc%icp(:) = acsc%icp(:) - 1
|
||||
!!$ info = amg_cslu_fact(nrow_a,nztota,acsc%val,&
|
||||
!!$ & acsc%icp,acsc%ia,sv%lufactors)
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_from_subroutine_
|
||||
!!$ ch_err='amg_cslu_fact'
|
||||
!!$ call psb_errpush(info,name,a_err=ch_err)
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ call acsc%free()
|
||||
!!$ call atmp%free()
|
||||
!!$
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' end'
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$ end subroutine c_slu_solver_bld
|
||||
subroutine c_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
complex(psb_spk_),intent(inout) :: x(:)
|
||||
complex(psb_spk_),intent(inout) :: y(:)
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_spk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
complex(psb_spk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='c_slu_solver_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
trans_ = psb_toupper(trans)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
case('T','C')
|
||||
case default
|
||||
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
goto 9999
|
||||
end select
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
n_row = desc_data%get_local_rows()
|
||||
n_col = desc_data%get_local_cols()
|
||||
|
||||
if (n_col <= size(work)) then
|
||||
ww => work(1:n_col)
|
||||
else
|
||||
allocate(ww(n_col),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_alloc_request_
|
||||
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
& a_err='complex(psb_spk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
ww(1:n_row) = x(1:n_row)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_cslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('T')
|
||||
info = amg_cslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('C')
|
||||
info = amg_cslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
case default
|
||||
call psb_errpush(psb_err_internal_error_, &
|
||||
& name,a_err='Invalid TRANS in ILU subsolve')
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
if (info == psb_success_) &
|
||||
& call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,&
|
||||
& name,a_err='Error in subsolve')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (n_col > size(work)) then
|
||||
deallocate(ww)
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine c_slu_solver_apply
|
||||
|
||||
subroutine c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_c_vect_type),intent(inout) :: x
|
||||
type(psb_c_vect_type),intent(inout) :: y
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
type(psb_c_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_c_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='c_slu_solver_apply_vect'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
call x%v%sync()
|
||||
call y%v%sync()
|
||||
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
call y%v%set_host()
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine c_slu_solver_apply_vect
|
||||
|
||||
subroutine c_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
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, intent(out) :: info
|
||||
type(psb_cspmat_type), intent(in), target, optional :: b
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_cspmat_type) :: atmp
|
||||
type(psb_c_csc_sparse_mat) :: acsc
|
||||
type(psb_c_coo_sparse_mat) :: acoo
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='c_slu_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||
|
||||
|
||||
n_row = desc_a%get_local_rows()
|
||||
n_col = desc_a%get_local_cols()
|
||||
|
||||
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
nrow_a = atmp%get_nrows()
|
||||
call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
call acsc%mv_from_coo(acoo,info)
|
||||
nztota = acsc%get_nzeros()
|
||||
! Fix the entries to call C-base SuperLU
|
||||
acsc%ia(:) = acsc%ia(:) - 1
|
||||
acsc%icp(:) = acsc%icp(:) - 1
|
||||
info = amg_cslu_fact(nrow_a,nztota,acsc%val,&
|
||||
& acsc%icp,acsc%ia,sv%lufactors)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='amg_cslu_fact'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acsc%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_slu_solver_bld
|
||||
|
||||
subroutine c_slu_solver_free(sv,info)
|
||||
|
||||
@@ -441,22 +385,20 @@ contains
|
||||
|
||||
end subroutine c_slu_solver_finalize
|
||||
|
||||
subroutine c_slu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_slu_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_slu_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
character(len=20), parameter :: name='amg_c_slu_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -465,13 +407,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
|
||||
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -88,25 +88,16 @@ contains
|
||||
val = "Symmetric Decoupled aggregation"
|
||||
end function amg_c_symdec_aggregator_fmt
|
||||
|
||||
subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_c_symdec_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
character(1024) :: prefix_
|
||||
info = psb_success_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_c_symdec_aggregator_descr
|
||||
|
||||
@@ -1,23 +0,0 @@
|
||||
#ifndef AMG_CONFIG_H
|
||||
#define AMG_CONFIG_H
|
||||
|
||||
#include "psb_config.h"
|
||||
|
||||
#define AMG_VERSION_MAJOR @AMGMAJOR@
|
||||
#define AMG_VERSION_MINOR @AMGMINOR@
|
||||
#define AMG_VERSION_PATCHLEVEL @AMGPATCH@
|
||||
#define AMG_VERSION_STRING @AMGSTRING@
|
||||
|
||||
|
||||
@CHAVEUMF@
|
||||
@CHAVESLU@
|
||||
@CSLUVERSION@
|
||||
@CHAVESLUDIST@
|
||||
@CSLUDISTVERSION@
|
||||
@CHAVEMUMPS@
|
||||
@CHAVEMUMPSMODULES@
|
||||
@CHAVEMUMPSINCLUDES@
|
||||
@CXXMATCHBOXBIT@
|
||||
|
||||
|
||||
#endif
|
||||
@@ -0,0 +1,107 @@
|
||||
/* This file was generated by a script using the mld_base_prec_type.F90 file as a basis. */
|
||||
#ifndef MLD_CONST_H_
|
||||
#define MLD_CONST_H_
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
#define MLD_VERSION_STRING_ ( "2.0.0" )
|
||||
#define MLD_VERSION_MAJOR_ ( 2 )
|
||||
#define MLD_VERSION_MINOR_ ( 0 )
|
||||
#define MLD_PATCHLEVEL_ ( 0 )
|
||||
#define MLD_SMOOTHER_TYPE_ ( 1 )
|
||||
#define MLD_SUB_SOLVE_ ( 2 )
|
||||
#define MLD_SUB_RESTR_ ( 3 )
|
||||
#define MLD_SUB_PROL_ ( 4 )
|
||||
#define MLD_SUB_REN_ ( 5 )
|
||||
#define MLD_SUB_OVR_ ( 6 )
|
||||
#define MLD_SUB_FILLIN_ ( 8 )
|
||||
#define MLD_SLU_PTR_ ( 10 )
|
||||
#define MLD_UMF_SYMPTR_ ( 12 )
|
||||
#define MLD_UMF_NUMPTR_ ( 14 )
|
||||
#define MLD_SLUD_PTR_ ( 16 )
|
||||
#define MLD_PREC_STATUS_ ( 18 )
|
||||
#define MLD_ML_TYPE_ ( 20 )
|
||||
#define MLD_SMOOTHER_SWEEPS_PRE_ ( 21 )
|
||||
#define MLD_SMOOTHER_SWEEPS_POST_ ( 22 )
|
||||
#define MLD_SMOOTHER_POS_ ( 23 )
|
||||
#define MLD_AGGR_KIND_ ( 24 )
|
||||
#define MLD_AGGR_ALG_ ( 25 )
|
||||
#define MLD_AGGR_OMEGA_ALG_ ( 26 )
|
||||
#define MLD_AGGR_EIG_ ( 27 )
|
||||
#define MLD_AGGR_FILTER_ ( 28 )
|
||||
#define MLD_COARSE_MAT_ ( 29 )
|
||||
#define MLD_COARSE_SOLVE_ ( 30 )
|
||||
#define MLD_COARSE_SWEEPS_ ( 31 )
|
||||
#define MLD_COARSE_FILLIN_ ( 32 )
|
||||
#define MLD_COARSE_SUBSOLVE_ ( 33 )
|
||||
#define MLD_SMOOTHER_SWEEPS_ ( 34 )
|
||||
#define MLD_IFPSZ_ ( 36 )
|
||||
#define MLD_MIN_PREC_ ( 0 )
|
||||
#define MLD_NOPREC_ ( 0 )
|
||||
#define MLD_JAC_ ( 1 )
|
||||
#define MLD_BJAC_ ( 2 )
|
||||
#define MLD_AS_ ( 3 )
|
||||
#define MLD_MAX_PREC_ ( 3 )
|
||||
#define MLD_SLV_DELTA_ ( MLD_MAX_PREC_+1 )
|
||||
#define MLD_F_NONE_ ( MLD_SLV_DELTA_+0 )
|
||||
#define MLD_DIAG_SCALE_ ( MLD_SLV_DELTA_+1 )
|
||||
#define MLD_ILU_N_ ( MLD_SLV_DELTA_+2 )
|
||||
#define MLD_MILU_N_ ( MLD_SLV_DELTA_+3 )
|
||||
#define MLD_ILU_T_ ( MLD_SLV_DELTA_+4 )
|
||||
#define MLD_SLU_ ( MLD_SLV_DELTA_+5 )
|
||||
#define MLD_UMF_ ( MLD_SLV_DELTA_+6 )
|
||||
#define MLD_SLUDIST_ ( MLD_SLV_DELTA_+7 )
|
||||
#define MLD_MAX_SUB_SOLVE_ ( MLD_SLV_DELTA_+7 )
|
||||
#define MLD_MIN_SUB_SOLVE_ ( MLD_DIAG_SCALE_ )
|
||||
#define MLD_RENUM_NONE_ (0 )
|
||||
#define MLD_RENUM_GLB_ (1 )
|
||||
#define MLD_RENUM_GPS_ (2 )
|
||||
#define MLD_MAX_RENUM_ (1 )
|
||||
#define MLD_NO_ML_ ( 0 )
|
||||
#define MLD_ADD_ML_ ( 1 )
|
||||
#define MLD_MULT_ML_ ( 2 )
|
||||
#define MLD_NEW_ML_PREC_ ( 3 )
|
||||
#define MLD_MAX_ML_TYPE_ ( MLD_MULT_ML_ )
|
||||
#define MLD_PRE_SMOOTH_ (1 )
|
||||
#define MLD_POST_SMOOTH_ (2 )
|
||||
#define MLD_TWOSIDE_SMOOTH_ (3 )
|
||||
#define MLD_MAX_SMOOTH_ (MLD_TWOSIDE_SMOOTH_ )
|
||||
#define MLD_NO_SMOOTH_ ( 0 )
|
||||
#define MLD_SMOOTH_PROL_ ( 1 )
|
||||
#define MLD_MIN_ENERGY_ ( 2 )
|
||||
#define MLD_BIZ_PROL_ ( 3 )
|
||||
#define MLD_MAX_AGGR_KIND_ (MLD_MIN_ENERGY_ )
|
||||
#define MLD_NO_FILTER_MAT_ (0 )
|
||||
#define MLD_FILTER_MAT_ (1 )
|
||||
#define MLD_MAX_FILTER_MAT_ (MLD_NO_FILTER_MAT_ )
|
||||
#define MLD_DEC_AGGR_ (0 )
|
||||
#define MLD_SYM_DEC_AGGR_ (1 )
|
||||
#define MLD_GLB_AGGR_ (2 )
|
||||
#define MLD_NEW_DEC_AGGR_ (3 )
|
||||
#define MLD_NEW_GLB_AGGR_ (4 )
|
||||
#define MLD_MAX_AGGR_ALG_ (MLD_DEC_AGGR_ )
|
||||
#define MLD_EIG_EST_ (0 )
|
||||
#define MLD_USER_CHOICE_ (999 )
|
||||
#define MLD_MAX_NORM_ (0 )
|
||||
#define MLD_DISTR_MAT_ (0 )
|
||||
#define MLD_REPL_MAT_ (1 )
|
||||
#define MLD_MAX_COARSE_MAT_ (MLD_REPL_MAT_ )
|
||||
#define MLD_PREC_BUILT_ (98765 )
|
||||
#define MLD_SUB_ILUTHRS_ ( 1 )
|
||||
#define MLD_AGGR_OMEGA_VAL_ ( 2 )
|
||||
#define MLD_AGGR_THRESH_ ( 3 )
|
||||
#define MLD_COARSE_ILUTHRS_ ( 4 )
|
||||
#define MLD_RFPSZ_ ( 8 )
|
||||
#define MLD_L_PR_ (1 )
|
||||
#define MLD_U_PR_ (2 )
|
||||
#define MLD_BP_ILU_AVSZ_ (2 )
|
||||
#define MLD_AP_ND_ (3 )
|
||||
#define MLD_AC_ (4 )
|
||||
#define MLD_SM_PR_T_ (5 )
|
||||
#define MLD_SM_PR_ (6 )
|
||||
#define MLD_SMTH_AVSZ_ (6 )
|
||||
#define MLD_MAX_AVSZ_ (MLD_SMTH_AVSZ_ )
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
@@ -20,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -58,10 +55,13 @@ module amg_d_ainv_solver
|
||||
procedure, pass(sv) :: check => amg_d_ainv_solver_check
|
||||
procedure, pass(sv) :: build => amg_d_ainv_solver_bld
|
||||
procedure, pass(sv) :: clone => amg_d_ainv_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_d_ainv_solver_clone_settings
|
||||
procedure, pass(sv) :: cseti => amg_d_ainv_solver_cseti
|
||||
procedure, pass(sv) :: csetc => amg_d_ainv_solver_csetc
|
||||
procedure, pass(sv) :: csetr => amg_d_ainv_solver_csetr
|
||||
procedure, pass(sv) :: seti => amg_d_ainv_solver_seti
|
||||
procedure, pass(sv) :: setc => amg_d_ainv_solver_setc
|
||||
procedure, pass(sv) :: setr => amg_d_ainv_solver_setr
|
||||
generic, public :: set => seti, setr, setc
|
||||
procedure, pass(sv) :: descr => amg_d_ainv_solver_descr
|
||||
procedure, pass(sv) :: default => d_ainv_solver_default
|
||||
procedure, nopass :: stringval => d_ainv_stringval
|
||||
@@ -83,16 +83,6 @@ module amg_d_ainv_solver
|
||||
end subroutine amg_d_ainv_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& amg_d_base_solver_type, psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_ainv_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
@@ -103,7 +93,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
|
||||
@@ -169,44 +159,44 @@ module amg_d_ainv_solver
|
||||
end subroutine amg_d_ainv_solver_csetr
|
||||
end interface
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine amg_d_ainv_solver_setc(sv,what,val,info)
|
||||
!!$ import :: amg_d_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ character(len=*), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_d_ainv_solver_setc
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_d_ainv_solver_seti(sv,what,val,info)
|
||||
!!$ import :: amg_d_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ integer(psb_ipk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_d_ainv_solver_seti
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_d_ainv_solver_setr(sv,what,val,info)
|
||||
!!$ import :: amg_d_ainv_solver_type, psb_ipk_, psb_dpk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ real(psb_dpk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_d_ainv_solver_setr
|
||||
!!$ end interface
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_setc(sv,what,val,info)
|
||||
import :: amg_d_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_ainv_solver_setc
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_d_ainv_solver_seti(sv,what,val,info)
|
||||
import :: amg_d_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_ainv_solver_seti
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_setr(sv,what,val,info)
|
||||
import :: amg_d_ainv_solver_type, psb_ipk_, psb_dpk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_ainv_solver_setr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -216,7 +206,7 @@ module amg_d_ainv_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_d_ainv_solver_descr
|
||||
end interface
|
||||
|
||||
@@ -225,7 +215,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
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -396,23 +396,21 @@ contains
|
||||
end subroutine d_as_smoother_default
|
||||
|
||||
|
||||
subroutine d_as_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine d_as_smoother_descr(sm,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_as_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_as_smoother_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
logical :: coarse_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -426,21 +424,16 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (.not.coarse_) then
|
||||
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
|
||||
write(iout_,*) ' Additive Schwarz with ',&
|
||||
& sm%novr, ' overlap layers.'
|
||||
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) trim(prefix_), ' Local solver:'
|
||||
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) ' Local solver:'
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
|
||||
call sm%sv%descr(info,iout_,coarse=coarse)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -89,7 +89,7 @@ module amg_d_base_aggregator_mod
|
||||
procedure, pass(ag) :: bld_tprol => amg_d_base_aggregator_build_tprol
|
||||
procedure, pass(ag) :: mat_bld => amg_d_base_aggregator_mat_bld
|
||||
procedure, pass(ag) :: mat_asb => amg_d_base_aggregator_mat_asb
|
||||
procedure, pass(ag) :: bld_linmap => amg_d_base_aggregator_bld_linmap
|
||||
procedure, pass(ag) :: bld_map => amg_d_base_aggregator_bld_map
|
||||
procedure, pass(ag) :: update_next => amg_d_base_aggregator_update_next
|
||||
procedure, pass(ag) :: clone => amg_d_base_aggregator_clone
|
||||
procedure, pass(ag) :: free => amg_d_base_aggregator_free
|
||||
@@ -126,7 +126,7 @@ module amg_d_base_aggregator_mod
|
||||
& psb_d_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_d_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -144,7 +144,7 @@ module amg_d_base_aggregator_mod
|
||||
& psb_d_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_d_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -275,22 +275,15 @@ contains
|
||||
val = .false.
|
||||
end function amg_d_base_aggregator_xt_desc
|
||||
|
||||
subroutine amg_d_base_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_d_base_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_d_base_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_d_base_aggregator_descr
|
||||
@@ -302,7 +295,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Do nothing
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
end subroutine amg_d_base_aggregator_set_aggr_type
|
||||
|
||||
@@ -458,7 +451,7 @@ contains
|
||||
end subroutine amg_d_base_aggregator_mat_asb
|
||||
|
||||
!
|
||||
!> Function bld_linmap
|
||||
!> Function bld_map
|
||||
!! \memberof amg_d_base_aggregator_type
|
||||
!! \brief Build linear map between hierarchy levels
|
||||
!!
|
||||
@@ -473,7 +466,7 @@ contains
|
||||
!! \param map The output map
|
||||
!! \param info Return code
|
||||
!!
|
||||
subroutine amg_d_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
subroutine amg_d_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
@@ -484,9 +477,8 @@ contains
|
||||
type(psb_dlinmap_type), intent(out) :: map
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_base_aggregator_bld_linmap'
|
||||
character(len=20) :: name='d_base_aggregator_bld_map'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
!
|
||||
! Copy the prolongation/restriction matrices into the descriptor map.
|
||||
@@ -508,6 +500,7 @@ contains
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine amg_d_base_aggregator_bld_linmap
|
||||
end subroutine amg_d_base_aggregator_bld_map
|
||||
|
||||
|
||||
end module amg_d_base_aggregator_mod
|
||||
|
||||
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
@@ -20,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -272,7 +272,7 @@ module amg_d_base_smoother_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_base_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_d_base_smoother_descr(sm,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
@@ -281,7 +281,6 @@ module amg_d_base_smoother_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_d_base_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -270,7 +270,7 @@ module amg_d_base_solver_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_base_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_d_base_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_base_solver_type, psb_ipk_
|
||||
@@ -281,7 +281,7 @@ module amg_d_base_solver_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_d_base_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -150,7 +150,7 @@ contains
|
||||
class(amg_d_dec_aggregator_type), intent(inout) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
info = psb_success_
|
||||
|
||||
select case(parms%aggr_type)
|
||||
case (amg_noalg_)
|
||||
ag%soc_map_bld => null()
|
||||
@@ -184,24 +184,16 @@ contains
|
||||
val = "Decoupled aggregation"
|
||||
end function amg_d_dec_aggregator_fmt
|
||||
|
||||
subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_d_dec_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
info = psb_success_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Decoupled Aggregator'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_d_dec_aggregator_descr
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -219,7 +219,7 @@ contains
|
||||
|
||||
end subroutine d_diag_solver_free
|
||||
|
||||
subroutine d_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -228,13 +228,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -242,13 +240,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Diagonal local solver '
|
||||
|
||||
write(iout_,*) ' Diagonal local solver '
|
||||
|
||||
return
|
||||
|
||||
@@ -331,7 +324,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
|
||||
@@ -359,7 +352,7 @@ module amg_d_l1_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_l1_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -368,13 +361,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_l1_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -382,13 +373,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
|
||||
|
||||
write(iout_,*) ' L1 Diagonal solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
+17
-31
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -433,22 +433,20 @@ contains
|
||||
return
|
||||
end subroutine d_gs_solver_free
|
||||
|
||||
subroutine d_gs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_gs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_gs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_gs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -457,17 +455,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
@@ -533,22 +526,20 @@ contains
|
||||
val = .true.
|
||||
end function d_gs_solver_is_iterative
|
||||
|
||||
subroutine d_bwgs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_bwgs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_bwgs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_bwgs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -557,17 +548,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
|
||||
@@ -0,0 +1,125 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
|
||||
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
! POSSIBILITY OF SUCH DAMAGE.
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! The aggregator object hosts the aggregation method for building
|
||||
! the multilevel hierarchy. This variant is based on the hybrid method
|
||||
! presented in
|
||||
!
|
||||
! S. Gratton, P. Henon, P. Jiranek and X. Vasseur:
|
||||
! Reducing complexity of algebraic multigrid by aggregation
|
||||
! Numerical Lin. Algebra with Applications, 2016, 23:501-518
|
||||
!
|
||||
module amg_d_hybrid_aggregator_mod
|
||||
|
||||
use amg_d_dec_aggregator_mod
|
||||
!
|
||||
! sm - class(amg_T_base_smoother_type), allocatable
|
||||
! The current level preconditioner (aka smoother).
|
||||
! parms - type(amg_RTml_parms)
|
||||
! The parameters defining the multilevel strategy.
|
||||
! ac - The local part of the current-level matrix, built by
|
||||
! coarsening the previous-level matrix.
|
||||
! desc_ac - type(psb_desc_type).
|
||||
! The communication descriptor associated to the matrix
|
||||
! stored in ac.
|
||||
! base_a - type(psb_Tspmat_type), pointer.
|
||||
! Pointer (really a pointer!) to the local part of the current
|
||||
! matrix (so we have a unified treatment of residuals).
|
||||
! We need this to avoid passing explicitly the current matrix
|
||||
! to the routine which applies the preconditioner.
|
||||
! base_desc - type(psb_desc_type), pointer.
|
||||
! Pointer to the communication descriptor associated to the
|
||||
! matrix pointed by base_a.
|
||||
! map - Stores the maps (restriction and prolongation) between the
|
||||
! vector spaces associated to the index spaces of the previous
|
||||
! and current levels.
|
||||
!
|
||||
! Methods:
|
||||
! Most methods follow the encapsulation hierarchy: they take whatever action
|
||||
! is appropriate for the current object, then call the corresponding method for
|
||||
! the contained object.
|
||||
! As an example: the descr() method prints out a description of the
|
||||
! level. It starts by invoking the descr() method of the parms object,
|
||||
! then calls the descr() method of the smoother object.
|
||||
!
|
||||
! descr - Prints a description of the object.
|
||||
! default - Set default values
|
||||
! dump - Dump to file object contents
|
||||
! set - Sets various parameters; when a request is unknown
|
||||
! it is passed to the smoother object for further processing.
|
||||
! check - Sanity checks.
|
||||
! sizeof - Total memory occupation in bytes
|
||||
! get_nzeros - Number of nonzeros
|
||||
!
|
||||
!
|
||||
type, extends(amg_d_dec_aggregator_type) :: amg_d_hybrid_aggregator_type
|
||||
|
||||
contains
|
||||
procedure, pass(ag) :: bld_tprol => amg_d_hybrid_aggregator_build_tprol
|
||||
procedure, nopass :: fmt => amg_d_hybrid_aggregator_fmt
|
||||
end type amg_d_hybrid_aggregator_type
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_d_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
import :: amg_d_hybrid_aggregator_type, psb_desc_type, psb_dspmat_type, psb_dpk_, &
|
||||
& psb_ipk_, psb_long_int_k_, amg_dml_parms
|
||||
implicit none
|
||||
class(amg_d_hybrid_aggregator_type), target, intent(inout) :: ag
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
|
||||
type(psb_dspmat_type), intent(out) :: op_prol
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_hybrid_aggregator_build_tprol
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
|
||||
function amg_d_hybrid_aggregator_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Hybrid Decoupled aggregation"
|
||||
end function amg_d_hybrid_aggregator_fmt
|
||||
|
||||
|
||||
end module amg_d_hybrid_aggregator_mod
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -157,7 +157,7 @@ contains
|
||||
return
|
||||
end subroutine d_id_solver_free
|
||||
|
||||
subroutine d_id_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_id_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -165,14 +165,12 @@ contains
|
||||
class(amg_d_id_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_id_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -180,13 +178,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Identity local solver '
|
||||
write(iout_,*) ' Identity local solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -234,7 +234,7 @@ contains
|
||||
! Arguments
|
||||
class(amg_d_ilu_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%fact_type = amg_ilu_n_
|
||||
sv%fact_type = psb_ilu_n_
|
||||
sv%fill_in = 0
|
||||
sv%thresh = dzero
|
||||
|
||||
@@ -255,13 +255,13 @@ contains
|
||||
info = psb_success_
|
||||
|
||||
call amg_check_def(sv%fact_type,&
|
||||
& 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
|
||||
& 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
|
||||
|
||||
select case(sv%fact_type)
|
||||
case(amg_ilu_n_,amg_milu_n_)
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
call amg_check_def(sv%fill_in,&
|
||||
& 'Level',izero,is_int_non_negative)
|
||||
case(amg_ilu_t_)
|
||||
case(psb_ilu_t_)
|
||||
call amg_check_def(sv%thresh,&
|
||||
& 'Eps',dzero,is_legal_d_fact_thrs)
|
||||
end select
|
||||
@@ -406,7 +406,7 @@ contains
|
||||
return
|
||||
end subroutine d_ilu_solver_free
|
||||
|
||||
subroutine d_ilu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_ilu_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -414,14 +414,12 @@ contains
|
||||
class(amg_d_ilu_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_ilu_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -430,20 +428,15 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
|
||||
write(iout_,*) ' Incomplete factorization solver: ',&
|
||||
& amg_fact_names(sv%fact_type)
|
||||
select case(sv%fact_type)
|
||||
case(amg_ilu_n_,amg_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
case(amg_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -496,7 +489,7 @@ contains
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_ilu_n_
|
||||
val = psb_ilu_n_
|
||||
end function d_ilu_solver_get_id
|
||||
|
||||
function d_ilu_solver_get_wrksize() result(val)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -39,7 +39,7 @@
|
||||
!
|
||||
! Module: amg_inner_mod
|
||||
!
|
||||
! This module defines the interfaces to inner AMG4PSBLAS routines.
|
||||
! This module defines the interfaces to inner MLD2P4 routines.
|
||||
! The interfaces of the user level routines are defined in amg_prec_mod.f90.
|
||||
!
|
||||
module amg_d_inner_mod
|
||||
@@ -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
|
||||
@@ -67,7 +67,7 @@ module amg_d_inner_mod
|
||||
end interface amg_mlprec_bld
|
||||
|
||||
interface amg_mlprec_aply
|
||||
subroutine amg_dmlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
subroutine amg_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: amg_dprec_type
|
||||
implicit none
|
||||
@@ -79,7 +79,7 @@ module amg_d_inner_mod
|
||||
character,intent(in) :: trans
|
||||
real(psb_dpk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_dmlprec_aply_a
|
||||
end subroutine amg_dmlprec_aply
|
||||
subroutine amg_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
import :: psb_dspmat_type, psb_desc_type, &
|
||||
& psb_dpk_, psb_d_vect_type, psb_ipk_
|
||||
@@ -109,12 +109,11 @@ module amg_d_inner_mod
|
||||
end interface amg_map_to_tprol
|
||||
|
||||
abstract interface
|
||||
subroutine amg_daggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
subroutine amg_daggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_, psb_lpk_, psb_ldspmat_type
|
||||
import :: amg_d_onelev_type, amg_dml_parms
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
|
||||
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
@@ -20,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -52,9 +49,10 @@ module amg_d_invk_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_d_invk_solver_check
|
||||
procedure, pass(sv) :: clone => amg_d_invk_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_d_invk_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_d_invk_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_d_invk_solver_cseti
|
||||
procedure, pass(sv) :: seti => amg_d_invk_solver_seti
|
||||
generic, public :: set => seti
|
||||
procedure, pass(sv) :: descr => amg_d_invk_solver_descr
|
||||
procedure, pass(sv) :: default => d_invk_solver_default
|
||||
end type amg_d_invk_solver_type
|
||||
@@ -74,17 +72,6 @@ module amg_d_invk_solver
|
||||
end subroutine amg_d_invk_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invk_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& amg_d_base_solver_type, psb_dpk_, amg_d_invk_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_d_invk_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_invk_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
@@ -94,7 +81,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
|
||||
@@ -135,7 +122,7 @@ module amg_d_invk_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invk_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_d_invk_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_dpk_, amg_d_invk_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -145,10 +132,22 @@ module amg_d_invk_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_d_invk_solver_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invk_solver_seti(sv,what,val,info)
|
||||
import :: amg_d_invk_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_d_invk_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_invk_solver_seti
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_invk_solver_default(sv)
|
||||
|
||||
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
@@ -20,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -52,10 +49,12 @@ module amg_d_invt_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_d_invt_solver_check
|
||||
procedure, pass(sv) :: clone => amg_d_invt_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_d_invt_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_d_invt_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_d_invt_solver_cseti
|
||||
procedure, pass(sv) :: csetr => amg_d_invt_solver_csetr
|
||||
procedure, pass(sv) :: seti => amg_d_invt_solver_seti
|
||||
procedure, pass(sv) :: setr => amg_d_invt_solver_setr
|
||||
generic, public :: set => seti, setr
|
||||
procedure, pass(sv) :: descr => amg_d_invt_solver_descr
|
||||
procedure, pass(sv) :: default => d_invt_solver_default
|
||||
end type amg_d_invt_solver_type
|
||||
@@ -74,17 +73,6 @@ module amg_d_invt_solver
|
||||
end subroutine amg_d_invt_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invt_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& amg_d_base_solver_type, psb_dpk_, amg_d_invt_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_d_invt_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_invt_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
@@ -94,7 +82,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
|
||||
@@ -146,21 +134,44 @@ module amg_d_invt_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invt_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_d_invt_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_dpk_, amg_d_invt_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_invt_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
end subroutine amg_d_invt_solver_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invt_solver_setr(sv,what,val,info)
|
||||
import :: amg_d_invt_solver_type, psb_dpk_, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_d_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_invt_solver_setr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invt_solver_seti(sv,what,val,info)
|
||||
import :: amg_d_invt_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_d_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_invt_solver_default(sv)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -203,8 +203,8 @@ module amg_d_jac_smoother
|
||||
subroutine amg_d_jac_smoother_clone_settings(sm,smout,info)
|
||||
import :: amg_d_jac_smoother_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
class(amg_d_jac_smoother_type), intent(inout) :: sm
|
||||
class(amg_d_base_smoother_type), intent(inout) :: smout
|
||||
class(amg_d_jac_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_jac_smoother_clone_settings
|
||||
end interface
|
||||
@@ -219,13 +219,12 @@ module amg_d_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_d_jac_smoother_type, psb_ipk_
|
||||
class(amg_d_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_d_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
@@ -274,7 +273,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
|
||||
@@ -314,13 +313,12 @@ module amg_d_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_d_l1_jac_smoother_type, psb_ipk_
|
||||
class(amg_d_l1_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_d_l1_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -1,585 +0,0 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific 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_jac_solver_mod.f90
|
||||
!
|
||||
! Module: amg_d_jac_solver_mod
|
||||
!
|
||||
! This module defines:
|
||||
! - the amg_d_jac_solver_type data structure containing the ingredients
|
||||
! for a local Jacobi iteration. The iterations are local to a process
|
||||
! (they operate on the block diagonal).
|
||||
!
|
||||
!
|
||||
module amg_d_jac_solver
|
||||
|
||||
use amg_d_base_solver_mod
|
||||
|
||||
type, extends(amg_d_base_solver_type) :: amg_d_jac_solver_type
|
||||
type(psb_dspmat_type) :: a
|
||||
type(psb_d_vect_type), allocatable :: dv
|
||||
real(psb_dpk_), allocatable :: d(:)
|
||||
integer(psb_ipk_) :: sweeps
|
||||
real(psb_dpk_) :: eps
|
||||
contains
|
||||
procedure, pass(sv) :: dump => amg_d_jac_solver_dmp
|
||||
procedure, pass(sv) :: check => d_jac_solver_check
|
||||
procedure, pass(sv) :: clone => amg_d_jac_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_d_jac_solver_clone_settings
|
||||
procedure, pass(sv) :: clear_data => amg_d_jac_solver_clear_data
|
||||
procedure, pass(sv) :: build => amg_d_jac_solver_bld
|
||||
procedure, pass(sv) :: cnv => amg_d_jac_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_d_jac_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_d_jac_solver_apply
|
||||
procedure, pass(sv) :: free => d_jac_solver_free
|
||||
procedure, pass(sv) :: cseti => d_jac_solver_cseti
|
||||
procedure, pass(sv) :: csetc => d_jac_solver_csetc
|
||||
procedure, pass(sv) :: csetr => d_jac_solver_csetr
|
||||
procedure, pass(sv) :: descr => d_jac_solver_descr
|
||||
procedure, pass(sv) :: default => d_jac_solver_default
|
||||
procedure, pass(sv) :: sizeof => d_jac_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => d_jac_solver_get_nzeros
|
||||
procedure, nopass :: get_wrksz => d_jac_solver_get_wrksize
|
||||
procedure, nopass :: get_fmt => d_jac_solver_get_fmt
|
||||
procedure, nopass :: get_id => d_jac_solver_get_id
|
||||
procedure, nopass :: is_iterative => d_jac_solver_is_iterative
|
||||
end type amg_d_jac_solver_type
|
||||
|
||||
type, extends(amg_d_jac_solver_type) :: amg_d_l1_jac_solver_type
|
||||
contains
|
||||
procedure, pass(sv) :: build => amg_d_l1_jac_solver_bld
|
||||
procedure, pass(sv) :: descr => d_l1_jac_solver_descr
|
||||
procedure, nopass :: get_fmt => d_l1_jac_solver_get_fmt
|
||||
procedure, nopass :: get_id => d_l1_jac_solver_get_id
|
||||
end type amg_d_l1_jac_solver_type
|
||||
|
||||
|
||||
private :: d_jac_solver_bld, d_jac_solver_apply, &
|
||||
& d_jac_solver_free, &
|
||||
& d_jac_solver_descr, d_jac_solver_sizeof, &
|
||||
& d_jac_solver_default, d_jac_solver_dmp, &
|
||||
& d_jac_solver_apply_vect, d_jac_solver_get_nzeros, &
|
||||
& d_jac_solver_get_fmt, d_jac_solver_check,&
|
||||
& d_jac_solver_is_iterative, &
|
||||
& d_jac_solver_get_id, d_jac_solver_get_wrksize
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_d_jac_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
|
||||
import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_d_jac_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_jac_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_d_l1_jac_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_l1_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_l1_jac_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_cnv(sv,info,amold,vmold,imold)
|
||||
import :: amg_d_jac_solver_type, psb_dpk_, &
|
||||
& psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_jac_solver_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
|
||||
& psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_jac_solver_type), intent(in) :: sv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: solver, global_num
|
||||
end subroutine amg_d_jac_solver_dmp
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_clone(sv,svout,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_base_solver_type, amg_d_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_jac_solver_clone
|
||||
end interface
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine amg_d_l1_jac_solver_clone(sv,svout,info)
|
||||
!!$ import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
!!$ & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
!!$ & amg_d_base_solver_type, amg_d_l1_jac_solver_type, psb_ipk_
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_d_l1_jac_solver_type), intent(inout) :: sv
|
||||
!!$ class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_d_l1_jac_solver_clone
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_base_solver_type, amg_d_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_jac_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_clear_data(sv,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_jac_solver_clear_data
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_jac_solver_default(sv)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%sweeps = ione
|
||||
sv%eps = dzero
|
||||
|
||||
return
|
||||
end subroutine d_jac_solver_default
|
||||
|
||||
subroutine d_jac_solver_check(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_jac_solver_check'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
call amg_check_def(sv%sweeps,&
|
||||
& 'Jacobi sweeps',ione,is_int_positive)
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_jac_solver_check
|
||||
|
||||
subroutine d_jac_solver_cseti(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_jac_solver_cseti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SOLVER_SWEEPS')
|
||||
sv%sweeps = val
|
||||
case default
|
||||
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_jac_solver_cseti
|
||||
|
||||
subroutine d_jac_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='d_jac_solver_csetc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_jac_solver_csetc
|
||||
|
||||
subroutine d_jac_solver_csetr(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_jac_solver_csetr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SOLVER_EPS')
|
||||
sv%eps = val
|
||||
case default
|
||||
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
|
||||
end select
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_jac_solver_csetr
|
||||
|
||||
subroutine d_jac_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_jac_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
call sv%a%free()
|
||||
if (allocated(sv%dv)) then
|
||||
call sv%dv%free(info)
|
||||
deallocate(sv%dv)
|
||||
end if
|
||||
if (allocated(sv%d)) deallocate(sv%d)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_jac_solver_free
|
||||
|
||||
subroutine d_jac_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_jac_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
iout_ = iout
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_jac_solver_descr
|
||||
|
||||
function d_jac_solver_get_nzeros(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = 0
|
||||
val = val + sv%a%get_nzeros()
|
||||
val = val + sv%dv%get_nrows()
|
||||
|
||||
return
|
||||
end function d_jac_solver_get_nzeros
|
||||
|
||||
function d_jac_solver_sizeof(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = psb_sizeof_ip
|
||||
val = val + sv%a%sizeof()
|
||||
val = val + sv%dv%sizeof()
|
||||
|
||||
return
|
||||
end function d_jac_solver_sizeof
|
||||
|
||||
function d_jac_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Jacobi solver"
|
||||
end function d_jac_solver_get_fmt
|
||||
|
||||
function d_jac_solver_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_jac_
|
||||
end function d_jac_solver_get_id
|
||||
|
||||
!
|
||||
! If this is true, then the solver needs a starting
|
||||
! guess. Currently only handled in JAC smoother.
|
||||
!
|
||||
function d_jac_solver_is_iterative() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function d_jac_solver_is_iterative
|
||||
|
||||
function d_jac_solver_get_wrksize() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = 2
|
||||
end function d_jac_solver_get_wrksize
|
||||
|
||||
subroutine d_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_l1_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_l1_jac_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
iout_ = iout
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_l1_jac_solver_descr
|
||||
|
||||
function d_l1_jac_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "L1-Jacobi solver"
|
||||
end function d_l1_jac_solver_get_fmt
|
||||
|
||||
function d_l1_jac_solver_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_l1_jac_
|
||||
end function d_l1_jac_solver_get_id
|
||||
|
||||
end module amg_d_jac_solver
|
||||
File diff suppressed because it is too large
Load Diff
@@ -3,9 +3,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -21,7 +21,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -52,10 +52,10 @@
|
||||
!
|
||||
module amg_d_mumps_solver
|
||||
use amg_d_base_solver_mod
|
||||
#if defined(AMG_HAVE_MUMPS) && defined(AMG_HAVE_MUMPS_MODULES)
|
||||
#if defined(HAVE_MUMPS_) && defined(HAVE_MUMPS_MODULES_)
|
||||
use dmumps_struc_def
|
||||
#endif
|
||||
#if defined(AMG_HAVE_MUMPS) && defined(AMG_HAVE_MUMPS_INCLUDES)
|
||||
#if defined(HAVE_MUMPS_) && defined(HAVE_MUMPS_INCLUDES_)
|
||||
include 'dmumps_struc.h'
|
||||
#endif
|
||||
|
||||
@@ -68,7 +68,7 @@ module amg_d_mumps_solver
|
||||
end type amg_d_mumps_rcntl_item
|
||||
|
||||
type, extends(amg_d_base_solver_type) :: amg_d_mumps_solver_type
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
type(dmumps_struc), allocatable :: id
|
||||
#else
|
||||
integer, allocatable :: id
|
||||
@@ -78,8 +78,7 @@ module amg_d_mumps_solver
|
||||
!
|
||||
! Controls to be set before MUMPS instantiation:
|
||||
!
|
||||
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: 'LOCAL_SOLVER
|
||||
! 1==amg_global_solver_: 'GLOBAL_SOLVER'
|
||||
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: LOCAL 1==amg_global_solver_: GLOBAL
|
||||
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
|
||||
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
|
||||
integer(psb_ipk_), dimension(3) :: ipar
|
||||
@@ -163,7 +162,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
|
||||
@@ -189,7 +188,7 @@ contains
|
||||
|
||||
info = 0
|
||||
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -239,7 +238,7 @@ contains
|
||||
character(len=20) :: name='d_mumps_solver_clear_data'
|
||||
|
||||
info = 0
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
call psb_erractionsave(err_act)
|
||||
if (allocated(sv%id)) then
|
||||
if (sv%built) then
|
||||
@@ -279,7 +278,7 @@ contains
|
||||
character(len=20) :: name='d_mumps_solver_free'
|
||||
|
||||
info = 0
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
call psb_erractionsave(err_act)
|
||||
call sv%clear_data(info)
|
||||
if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
|
||||
@@ -314,24 +313,22 @@ subroutine d_mumps_solver_finalize(sv)
|
||||
|
||||
end subroutine d_mumps_solver_finalize
|
||||
|
||||
subroutine d_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_mumps_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_mumps_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: me, np
|
||||
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -340,13 +337,8 @@ subroutine d_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
|
||||
write(iout_,*) ' MUMPS Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -383,7 +375,7 @@ subroutine d_mumps_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
case('MUMPS_LOC_GLOB')
|
||||
sv%ipar(1) = sv%stringval(psb_toupper(trim(val)))
|
||||
#endif
|
||||
@@ -421,7 +413,7 @@ subroutine d_mumps_solver_cseti(sv,what,val,info,idx)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(what))
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
case('MUMPS_LOC_GLOB')
|
||||
sv%ipar(1) = val
|
||||
case('MUMPS_PRINT_ERR')
|
||||
@@ -467,7 +459,7 @@ subroutine d_mumps_solver_csetr(sv,what,val,info,idx)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(what))
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
case('MUMPS_RPAR_ENTRY')
|
||||
if(present(idx)) then
|
||||
! Note: this will allocate %item
|
||||
@@ -504,7 +496,7 @@ subroutine d_mumps_solver_default(sv)
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
if (.not.allocated(sv%id)) then
|
||||
allocate(sv%id,stat=info)
|
||||
if (info /= psb_success_) then
|
||||
@@ -561,7 +553,7 @@ function d_mumps_solver_sizeof(sv) result(val)
|
||||
class(amg_d_mumps_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer :: i
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
val = (sv%id%INFOG(22)+sv%id%INFOG(32))*1d+6
|
||||
#else
|
||||
val = 0
|
||||
|
||||
+392
-349
File diff suppressed because it is too large
Load Diff
@@ -1,684 +0,0 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific 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.
|
||||
!
|
||||
! moved here from amg4psblas-extension
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS Extensions
|
||||
!
|
||||
! (C) Copyright 2019
|
||||
!
|
||||
! Salvatore Filippone Cranfield University
|
||||
! Pasqua D'Ambra IAC-CNR, Naples, IT
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific 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.
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! The aggregator object hosts the aggregation method for building
|
||||
! the multilevel hierarchy. This variant is based on the hybrid method
|
||||
! presented in
|
||||
!
|
||||
!
|
||||
! sm - class(amg_T_base_smoother_type), allocatable
|
||||
! The current level preconditioner (aka smoother).
|
||||
! parms - type(amg_RTml_parms)
|
||||
! The parameters defining the multilevel strategy.
|
||||
! ac - The local part of the current-level matrix, built by
|
||||
! coarsening the previous-level matrix.
|
||||
! desc_ac - type(psb_desc_type).
|
||||
! The communication descriptor associated to the matrix
|
||||
! stored in ac.
|
||||
! base_a - type(psb_Tspmat_type), pointer.
|
||||
! Pointer (really a pointer!) to the local part of the current
|
||||
! matrix (so we have a unified treatment of residuals).
|
||||
! We need this to avoid passing explicitly the current matrix
|
||||
! to the routine which applies the preconditioner.
|
||||
! base_desc - type(psb_desc_type), pointer.
|
||||
! Pointer to the communication descriptor associated to the
|
||||
! matrix pointed by base_a.
|
||||
! map - Stores the maps (restriction and prolongation) between the
|
||||
! vector spaces associated to the index spaces of the previous
|
||||
! and current levels.
|
||||
!
|
||||
! Methods:
|
||||
! Most methods follow the encapsulation hierarchy: they take whatever action
|
||||
! is appropriate for the current object, then call the corresponding method for
|
||||
! the contained object.
|
||||
! As an example: the descr() method prints out a description of the
|
||||
! level. It starts by invoking the descr() method of the parms object,
|
||||
! then calls the descr() method of the smoother object.
|
||||
!
|
||||
! descr - Prints a description of the object.
|
||||
! default - Set default values
|
||||
! dump - Dump to file object contents
|
||||
! set - Sets various parameters; when a request is unknown
|
||||
! it is passed to the smoother object for further processing.
|
||||
! check - Sanity checks.
|
||||
! sizeof - Total memory occupation in bytes
|
||||
! get_nzeros - Number of nonzeros
|
||||
!
|
||||
!
|
||||
|
||||
module amg_d_parmatch_aggregator_mod
|
||||
use amg_d_base_aggregator_mod
|
||||
use amg_d_matchboxp_mod
|
||||
type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
|
||||
integer(psb_ipk_) :: matching_alg
|
||||
integer(psb_ipk_) :: n_sweeps ! When n_sweeps >1 we need an auxiliary descriptor
|
||||
integer(psb_ipk_) :: orig_aggr_size
|
||||
integer(psb_ipk_) :: jacobi_sweeps
|
||||
real(psb_dpk_), allocatable :: w(:), w_nxt(:)
|
||||
type(psb_dspmat_type), allocatable :: prol, restr
|
||||
type(psb_dspmat_type), allocatable :: ac, base_a, rwa
|
||||
type(psb_desc_type), allocatable :: desc_ac, desc_ax, base_desc, rwdesc
|
||||
logical :: reproducible_matching = .false.
|
||||
logical :: need_symmetrize = .false.
|
||||
logical :: unsmoothed_hierarchy = .true.
|
||||
contains
|
||||
procedure, pass(ag) :: bld_tprol => amg_d_parmatch_aggregator_build_tprol
|
||||
procedure, pass(ag) :: mat_bld => amg_d_parmatch_aggregator_mat_bld
|
||||
procedure, pass(ag) :: mat_asb => amg_d_parmatch_aggregator_mat_asb
|
||||
procedure, pass(ag) :: inner_mat_asb => amg_d_parmatch_aggregator_inner_mat_asb
|
||||
procedure, pass(ag) :: bld_linmap => amg_d_parmatch_aggregator_bld_linmap
|
||||
procedure, pass(ag) :: csetc => amg_d_parmatch_aggr_csetc
|
||||
procedure, pass(ag) :: cseti => amg_d_parmatch_aggr_cseti
|
||||
procedure, pass(ag) :: default => amg_d_parmatch_aggr_set_default
|
||||
procedure, pass(ag) :: sizeof => amg_d_parmatch_aggregator_sizeof
|
||||
procedure, pass(ag) :: update_next => amg_d_parmatch_aggregator_update_next
|
||||
procedure, pass(ag) :: bld_wnxt => amg_d_parmatch_bld_wnxt
|
||||
procedure, pass(ag) :: bld_default_w => amg_d_bld_default_w
|
||||
procedure, pass(ag) :: set_c_default_w => amg_d_set_prm_c_default_w
|
||||
procedure, pass(ag) :: descr => amg_d_parmatch_aggregator_descr
|
||||
procedure, pass(ag) :: clone => amg_d_parmatch_aggregator_clone
|
||||
procedure, pass(ag) :: free => amg_d_parmatch_aggregator_free
|
||||
procedure, nopass :: fmt => amg_d_parmatch_aggregator_fmt
|
||||
procedure, nopass :: xt_desc => amg_d_parmatch_aggregator_xt_desc
|
||||
end type amg_d_parmatch_aggregator_type
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
& a,desc_a,ilaggr,nlaggr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(amg_daggr_data), intent(in) :: ag_data
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
|
||||
type(psb_ldspmat_type), intent(out) :: t_prol
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_aggregator_build_tprol
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(psb_ldspmat_type), intent(inout) :: t_prol
|
||||
type(psb_dspmat_type), intent(out) :: op_prol,ac,op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_aggregator_mat_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
|
||||
& ac,desc_ac, op_prol,op_restr,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol,ac,op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_aggregator_mat_asb
|
||||
end interface
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
|
||||
& ac,desc_ac, op_prol,op_restr,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol,op_restr
|
||||
type(psb_dspmat_type), intent(inout) :: ac
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_aggregator_inner_mat_asb
|
||||
end interface
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_ldspmat_type), intent(inout) :: t_prol
|
||||
type(psb_dspmat_type), intent(inout) :: ac, op_prol, op_restr
|
||||
type(psb_desc_type), intent(out) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_spmm_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_ldspmat_type), intent(inout) :: t_prol
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_unsmth_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_ldspmat_type), intent(inout) :: t_prol
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_smth_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_ldspmat_type), intent(inout) :: t_prol
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(out) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_spmm_bld_ov
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_spmm_bld_inner(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data,&
|
||||
& psb_d_csr_sparse_mat, psb_ld_csr_sparse_mat
|
||||
implicit none
|
||||
type(psb_d_csr_sparse_mat), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_ldspmat_type), intent(inout) :: t_prol
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(out) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_spmm_bld_inner
|
||||
end interface
|
||||
|
||||
private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels
|
||||
|
||||
contains
|
||||
|
||||
subroutine amg_d_bld_default_w(ag,nr)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
integer(psb_ipk_), intent(in) :: nr
|
||||
integer(psb_ipk_) :: info
|
||||
call psb_realloc(nr,ag%w,info)
|
||||
if (info /= psb_success_) return
|
||||
ag%w = done
|
||||
!call ag%set_c_default_w()
|
||||
end subroutine amg_d_bld_default_w
|
||||
|
||||
subroutine amg_d_set_prm_c_default_w(ag)
|
||||
use psb_realloc_mod
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
!write(0,*) 'prm_c_deafult_w '
|
||||
call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
|
||||
|
||||
end subroutine amg_d_set_prm_c_default_w
|
||||
|
||||
subroutine amg_d_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
integer(psb_lpk_), intent(in) :: ilaggr(:)
|
||||
real(psb_dpk_), intent(in) :: valaggr(:)
|
||||
integer(psb_ipk_), intent(in) :: nx
|
||||
|
||||
integer(psb_ipk_) :: info,i,j
|
||||
|
||||
! The vector was already fixed in the call to BCMatch.
|
||||
!write(0,*) 'Executing bld_wnxt ',nx
|
||||
call psb_realloc(nx,ag%w_nxt,info)
|
||||
|
||||
end subroutine amg_d_parmatch_bld_wnxt
|
||||
|
||||
function amg_d_parmatch_aggregator_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Parallel Matching aggregation"
|
||||
end function amg_d_parmatch_aggregator_fmt
|
||||
|
||||
function amg_d_parmatch_aggregator_xt_desc() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function amg_d_parmatch_aggregator_xt_desc
|
||||
|
||||
function amg_d_parmatch_aggregator_sizeof(ag) result(val)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), intent(in) :: ag
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = 4
|
||||
val = val + psb_size(ag%w) + psb_size(ag%w_nxt)
|
||||
if (allocated(ag%ac)) val = val + ag%ac%sizeof()
|
||||
if (allocated(ag%base_a)) val = val + ag%base_a%sizeof()
|
||||
if (allocated(ag%prol)) val = val + ag%prol%sizeof()
|
||||
if (allocated(ag%restr)) val = val + ag%restr%sizeof()
|
||||
if (allocated(ag%desc_ac)) val = val + ag%desc_ac%sizeof()
|
||||
if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
|
||||
if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
|
||||
|
||||
end function amg_d_parmatch_aggregator_sizeof
|
||||
|
||||
subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
info = psb_success_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
|
||||
write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps
|
||||
write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_d_parmatch_aggregator_descr
|
||||
|
||||
function is_legal_malg(alg) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: alg
|
||||
|
||||
val = (0==alg)
|
||||
end function is_legal_malg
|
||||
|
||||
function is_legal_csize(csize) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: csize
|
||||
|
||||
val = ((-1==csize).or.(csize >0))
|
||||
end function is_legal_csize
|
||||
|
||||
function is_legal_nsweeps(nsw) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: nsw
|
||||
|
||||
val = (1<=nsw)
|
||||
end function is_legal_nsweeps
|
||||
|
||||
function is_legal_nlevels(nlv) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: nlv
|
||||
|
||||
val = (1<=nlv)
|
||||
end function is_legal_nlevels
|
||||
|
||||
|
||||
subroutine amg_d_parmatch_aggregator_update_next(ag,agnext,info)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
class(amg_d_base_aggregator_type), target, intent(inout) :: agnext
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
!
|
||||
select type(agnext)
|
||||
class is (amg_d_parmatch_aggregator_type)
|
||||
if (.not.is_legal_malg(agnext%matching_alg)) &
|
||||
& agnext%matching_alg = ag%matching_alg
|
||||
if (.not.is_legal_nsweeps(agnext%n_sweeps))&
|
||||
& agnext%n_sweeps = ag%n_sweeps
|
||||
!!$ if (.not.is_legal_csize(agnext%max_csize))&
|
||||
!!$ & agnext%max_csize = ag%max_csize
|
||||
!!$ if (.not.is_legal_nlevels(agnext%max_nlevels))&
|
||||
!!$ & agnext%max_nlevels = ag%max_nlevels
|
||||
! Is this going to generate shallow copies/memory leaks/double frees?
|
||||
! To be investigated further.
|
||||
call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
|
||||
call agnext%set_c_default_w()
|
||||
if (ag%unsmoothed_hierarchy) then
|
||||
agnext%unsmoothed_hierarchy = .true.
|
||||
call move_alloc(ag%rwdesc,agnext%base_desc)
|
||||
call move_alloc(ag%rwa,agnext%base_a)
|
||||
end if
|
||||
|
||||
class default
|
||||
! What should we do here?
|
||||
end select
|
||||
info = 0
|
||||
end subroutine amg_d_parmatch_aggregator_update_next
|
||||
|
||||
subroutine amg_d_parmatch_aggr_csetc(ag,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, iwhat
|
||||
character(len=20) :: name='d_parmatch_aggr_cseti'
|
||||
info = psb_success_
|
||||
|
||||
! For now we ignore IDX
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('PRMC_REPRODUCIBLE_MATCHING')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('F','FALSE')
|
||||
ag%reproducible_matching = .false.
|
||||
case('REPRODUCIBLE','TRUE','T')
|
||||
ag%reproducible_matching =.true.
|
||||
end select
|
||||
case('PRMC_NEED_SYMMETRIZE')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('FALSE','F')
|
||||
ag%need_symmetrize = .false.
|
||||
case('SYMMETRIZE','TRUE','T')
|
||||
ag%need_symmetrize =.true.
|
||||
end select
|
||||
case('PRMC_UNSMOOTHED_HIERARCHY')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('F','FALSE')
|
||||
ag%unsmoothed_hierarchy = .false.
|
||||
case('T','TRUE')
|
||||
ag%unsmoothed_hierarchy =.true.
|
||||
end select
|
||||
case default
|
||||
! Do nothing
|
||||
end select
|
||||
return
|
||||
end subroutine amg_d_parmatch_aggr_csetc
|
||||
|
||||
subroutine amg_d_parmatch_aggr_cseti(ag,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, iwhat
|
||||
character(len=20) :: name='d_parmatch_aggr_cseti'
|
||||
info = psb_success_
|
||||
|
||||
! For now we ignore IDX
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('PRMC_MATCH_ALG')
|
||||
ag%matching_alg=val
|
||||
case('PRMC_SWEEPS')
|
||||
ag%n_sweeps=val
|
||||
case('AGGR_SIZE')
|
||||
ag%orig_aggr_size = val
|
||||
ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
|
||||
case('PRMC_W_SIZE')
|
||||
call ag%bld_default_w(val)
|
||||
case('PRMC_REPRODUCIBLE_MATCHING')
|
||||
ag%reproducible_matching = (val == 1)
|
||||
case('PRMC_NEED_SYMMETRIZE')
|
||||
ag%need_symmetrize = (val == 1)
|
||||
case('PRMC_UNSMOOTHED_HIERARCHY')
|
||||
ag%unsmoothed_hierarchy = (val == 1)
|
||||
case default
|
||||
! Do nothing
|
||||
end select
|
||||
return
|
||||
end subroutine amg_d_parmatch_aggr_cseti
|
||||
|
||||
subroutine amg_d_parmatch_aggr_set_default(ag)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
|
||||
character(len=20) :: name='d_parmatch_aggr_set_default'
|
||||
call ag%amg_d_base_aggregator_type%default()
|
||||
ag%matching_alg = 0
|
||||
ag%n_sweeps = 1
|
||||
ag%jacobi_sweeps = 0
|
||||
!!$ ag%max_nlevels = 36
|
||||
!!$ ag%max_csize = -1
|
||||
!
|
||||
! Apparently BootCMatch works better
|
||||
! by keeping all entries
|
||||
!
|
||||
ag%do_clean_zeros = .false.
|
||||
|
||||
return
|
||||
|
||||
end subroutine amg_d_parmatch_aggr_set_default
|
||||
|
||||
subroutine amg_d_parmatch_aggregator_free(ag,info)
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
if ((info == 0).and.allocated(ag%w)) deallocate(ag%w,stat=info)
|
||||
if ((info == 0).and.allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info)
|
||||
if ((info == 0).and.allocated(ag%prol)) then
|
||||
call ag%prol%free(); deallocate(ag%prol,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%restr)) then
|
||||
call ag%restr%free(); deallocate(ag%restr,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%ac)) then
|
||||
call ag%ac%free(); deallocate(ag%ac,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%base_a)) then
|
||||
call ag%base_a%free(); deallocate(ag%base_a,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%rwa)) then
|
||||
call ag%rwa%free(); deallocate(ag%rwa,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%desc_ac)) then
|
||||
call ag%desc_ac%free(info); deallocate(ag%desc_ac,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%desc_ax)) then
|
||||
call ag%desc_ax%free(info); deallocate(ag%desc_ax,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%base_desc)) then
|
||||
call ag%base_desc%free(info); deallocate(ag%base_desc,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%rwdesc)) then
|
||||
call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine amg_d_parmatch_aggregator_free
|
||||
|
||||
subroutine amg_d_parmatch_aggregator_clone(ag,agnext,info)
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
|
||||
class(amg_d_base_aggregator_type), allocatable, intent(inout) :: agnext
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(agnext)) then
|
||||
call agnext%free(info)
|
||||
if (info == 0) deallocate(agnext,stat=info)
|
||||
end if
|
||||
if (info /= 0) return
|
||||
allocate(agnext,source=ag,stat=info)
|
||||
select type(agnext)
|
||||
class is (amg_d_parmatch_aggregator_type)
|
||||
call agnext%set_c_default_w()
|
||||
class default
|
||||
! Should never ever get here
|
||||
info = -1
|
||||
end select
|
||||
end subroutine amg_d_parmatch_aggregator_clone
|
||||
|
||||
subroutine amg_d_parmatch_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(psb_desc_type), intent(in), target :: desc_a, desc_ac
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol, op_restr
|
||||
type(psb_dlinmap_type), intent(out) :: map
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_parmatch_aggregator_bld_linmap'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
!
|
||||
! Copy the prolongation/restriction matrices into the descriptor map.
|
||||
! op_restr => PR^T i.e. restriction operator
|
||||
! op_prol => PR i.e. prolongation operator
|
||||
!
|
||||
! For parmatch have an explicit copy of the descriptors
|
||||
!
|
||||
if (allocated(ag%desc_ax)) then
|
||||
!!$ write(0,*) 'Building linmap with ag%desc_ax ',ag%desc_ax%get_local_rows(),ag%desc_ax%get_local_cols(),&
|
||||
!!$ & desc_ac%get_local_rows(),desc_ac%get_local_cols()
|
||||
map = psb_linmap(psb_map_gen_linear_,ag%desc_ax,&
|
||||
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
|
||||
else
|
||||
map = psb_linmap(psb_map_gen_linear_,desc_a,&
|
||||
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine amg_d_parmatch_aggregator_bld_linmap
|
||||
end module amg_d_parmatch_aggregator_mod
|
||||
@@ -1,548 +0,0 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Daniela di Serafino
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific 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_poly_smoother_mod.f90
|
||||
!
|
||||
! Module: amg_d_poly_smoother_mod
|
||||
!
|
||||
! This module defines:
|
||||
! the amg_d_poly_smoother_type data structure containing the
|
||||
! smoother for a Jacobi/block Jacobi smoother.
|
||||
! The smoother stores in ND the block off-diagonal matrix.
|
||||
! One special case is treated separately, when the solver is DIAG or L1-DIAG
|
||||
! then the ND is the entire off-diagonal part of the matrix (including the
|
||||
! main diagonal block), so that it becomes possible to implement
|
||||
! a pure Jacobi or L1-Jacobi global solver.
|
||||
!
|
||||
module amg_d_poly_coeff_mod
|
||||
use psb_base_mod
|
||||
|
||||
real(psb_dpk_), parameter :: amg_d_poly_a_vect(30) = [ &
|
||||
& 0.3333333333333333_psb_dpk_, &
|
||||
& 0.1805359927403007_psb_dpk_, &
|
||||
& 0.1159278464862213_psb_dpk_, &
|
||||
& 0.0820780659590383_psb_dpk_, &
|
||||
& 0.0618496002413377_psb_dpk_, &
|
||||
& 0.0486605823426062_psb_dpk_, &
|
||||
& 0.0395132986024057_psb_dpk_, &
|
||||
& 0.0328701017544880_psb_dpk_, &
|
||||
& 0.0278702862721800_psb_dpk_, &
|
||||
& 0.0239987409600620_psb_dpk_, &
|
||||
& 0.0209304400432259_psb_dpk_, &
|
||||
& 0.0184513099045066_psb_dpk_, &
|
||||
& 0.0164152586042591_psb_dpk_, &
|
||||
& 0.0147195638076874_psb_dpk_, &
|
||||
& 0.0132901324757843_psb_dpk_, &
|
||||
& 0.0120723317737698_psb_dpk_, &
|
||||
& 0.0110250964606384_psb_dpk_, &
|
||||
& 0.0101170330064859_psb_dpk_, &
|
||||
& 0.0093237789039835_psb_dpk_, &
|
||||
& 0.0086261728849515_psb_dpk_, &
|
||||
& 0.0080089618703679_psb_dpk_, &
|
||||
& 0.0074598709610601_psb_dpk_, &
|
||||
& 0.0069689238144320_psb_dpk_, &
|
||||
& 0.0065279387776372_psb_dpk_, &
|
||||
& 0.0061301503808627_psb_dpk_, &
|
||||
& 0.0057699215598864_psb_dpk_, &
|
||||
& 0.0054425224281914_psb_dpk_, &
|
||||
& 0.0051439584672521_psb_dpk_, &
|
||||
& 0.0048708358327268_psb_dpk_, &
|
||||
& 0.0046202548314912_psb_dpk_ ];
|
||||
|
||||
real(psb_dpk_), parameter :: amg_d_poly_beta_vect(900) = [ &
|
||||
& 1.1250000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0238728757031315_psb_dpk_, 1.2640890537108553_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0084254478202830_psb_dpk_, 1.0886783920873087_psb_dpk_, &
|
||||
& 1.3375312590961856_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0039131042728535_psb_dpk_, 1.0403581118859304_psb_dpk_, &
|
||||
& 1.1486349854625493_psb_dpk_, 1.3826886924100055_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0021293014616472_psb_dpk_, 1.0217371154926094_psb_dpk_, &
|
||||
& 1.0787243319260302_psb_dpk_, 1.1981006529266300_psb_dpk_, &
|
||||
& 1.4132254279168215_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0012851725594023_psb_dpk_, 1.0130429303523338_psb_dpk_, &
|
||||
& 1.0467821512411335_psb_dpk_, 1.1161648941967548_psb_dpk_, &
|
||||
& 1.2382902021844453_psb_dpk_, 1.4352429710674484_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0008346439791242_psb_dpk_, 1.0084394943012289_psb_dpk_, &
|
||||
& 1.0300870776871385_psb_dpk_, 1.0740838409200377_psb_dpk_, &
|
||||
& 1.1503618670736642_psb_dpk_, 1.2711647404613990_psb_dpk_, &
|
||||
& 1.4518665864936395_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0005724663119766_psb_dpk_, 1.0057742766241562_psb_dpk_, &
|
||||
& 1.0205018792294143_psb_dpk_, 1.0501980344456543_psb_dpk_, &
|
||||
& 1.1011557298494106_psb_dpk_, 1.1808604280685657_psb_dpk_, &
|
||||
& 1.2983858538257604_psb_dpk_, 1.4648607315109978_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0004096007283281_psb_dpk_, 1.0041243950610661_psb_dpk_, &
|
||||
& 1.0146021214826659_psb_dpk_, 1.0356111362667175_psb_dpk_, &
|
||||
& 1.0713997252919425_psb_dpk_, 1.1268827371096291_psb_dpk_, &
|
||||
& 1.2078521914072933_psb_dpk_, 1.3212193071674674_psb_dpk_, &
|
||||
& 1.4752964282069962_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0003031222965291_psb_dpk_, 1.0030484066079688_psb_dpk_, &
|
||||
& 1.0107702271538761_psb_dpk_, 1.0261901159764004_psb_dpk_, &
|
||||
& 1.0523172493375519_psb_dpk_, 1.0925574320754976_psb_dpk_, &
|
||||
& 1.1508337666397197_psb_dpk_, 1.2317225087089441_psb_dpk_, &
|
||||
& 1.3406080202445980_psb_dpk_, 1.4838612440701109_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0002305859520939_psb_dpk_, 1.0023167502402850_psb_dpk_, &
|
||||
& 1.0081724539630488_psb_dpk_, 1.0198298656634219_psb_dpk_, &
|
||||
& 1.0395021023532465_psb_dpk_, 1.0696504270054137_psb_dpk_, &
|
||||
& 1.1130575429574259_psb_dpk_, 1.1729087627556418_psb_dpk_, &
|
||||
& 1.2528830057679230_psb_dpk_, 1.3572557991951903_psb_dpk_, &
|
||||
& 1.4910167256413891_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0001794720082837_psb_dpk_, 1.0018018913961957_psb_dpk_, &
|
||||
& 1.0063486190730762_psb_dpk_, 1.0153786456630600_psb_dpk_, &
|
||||
& 1.0305694283076039_psb_dpk_, 1.0537601969394355_psb_dpk_, &
|
||||
& 1.0869986259207296_psb_dpk_, 1.1325918309791341_psb_dpk_, &
|
||||
& 1.1931627335817252_psb_dpk_, 1.2717129367511055_psb_dpk_, &
|
||||
& 1.3716933796979953_psb_dpk_, 1.4970841857556243_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0001424192155957_psb_dpk_, 1.0014290693262966_psb_dpk_, &
|
||||
& 1.0050302898629815_psb_dpk_, 1.0121691051849540_psb_dpk_, &
|
||||
& 1.0241487434279255_psb_dpk_, 1.0423815888082042_psb_dpk_, &
|
||||
& 1.0684200812870084_psb_dpk_, 1.1039901093675994_psb_dpk_, &
|
||||
& 1.1510274824264566_psb_dpk_, 1.2117181191012512_psb_dpk_, &
|
||||
& 1.2885426486512805_psb_dpk_, 1.3843261938099158_psb_dpk_, &
|
||||
& 1.5022941875736890_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0001149053826193_psb_dpk_, 1.0011524637691460_psb_dpk_, &
|
||||
& 1.0040535733326481_psb_dpk_, 1.0097959057315313_psb_dpk_, &
|
||||
& 1.0194130047299461_psb_dpk_, 1.0340142503543679_psb_dpk_, &
|
||||
& 1.0548059960662932_psb_dpk_, 1.0831142030181304_psb_dpk_, &
|
||||
& 1.1204089166089239_psb_dpk_, 1.1683309565544606_psb_dpk_, &
|
||||
& 1.2287212228823874_psb_dpk_, 1.3036530570781755_psb_dpk_, &
|
||||
& 1.3954681405367855_psb_dpk_, 1.5068164620958386_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000940475075257_psb_dpk_, 1.0009429169634352_psb_dpk_, &
|
||||
& 1.0033144905644482_psb_dpk_, 1.0080029483381612_psb_dpk_, &
|
||||
& 1.0158423625914039_psb_dpk_, 1.0277208331770495_psb_dpk_, &
|
||||
& 1.0445953542283146_psb_dpk_, 1.0675076120612534_psb_dpk_, &
|
||||
& 1.0976009254588965_psb_dpk_, 1.1361385536615733_psb_dpk_, &
|
||||
& 1.1845236142623621_psb_dpk_, 1.2443208730447588_psb_dpk_, &
|
||||
& 1.3172806908339272_psb_dpk_, 1.4053654389356023_psb_dpk_, &
|
||||
& 1.5107787250184523_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000779482817921_psb_dpk_, 1.0007812684725339_psb_dpk_, &
|
||||
& 1.0027448797440124_psb_dpk_, 1.0066229101701514_psb_dpk_, &
|
||||
& 1.0130985883697137_psb_dpk_, 1.0228944832933697_psb_dpk_, &
|
||||
& 1.0367832140998394_psb_dpk_, 1.0555987571989653_psb_dpk_, &
|
||||
& 1.0802484840556024_psb_dpk_, 1.1117260713149764_psb_dpk_, &
|
||||
& 1.1511254343107276_psb_dpk_, 1.1996558461497355_psb_dpk_, &
|
||||
& 1.2586584174494597_psb_dpk_, 1.3296241265666493_psb_dpk_, &
|
||||
& 1.4142136069557629_psb_dpk_, 1.5142789173034623_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000653242183546_psb_dpk_, 1.0006545722939437_psb_dpk_, &
|
||||
& 1.0022987777448662_psb_dpk_, 1.0055432691173583_psb_dpk_, &
|
||||
& 1.0109550075016893_psb_dpk_, 1.0191301541168694_psb_dpk_, &
|
||||
& 1.0307019481191382_psb_dpk_, 1.0463489778000818_psb_dpk_, &
|
||||
& 1.0668039321569163_psb_dpk_, 1.0928629244731740_psb_dpk_, &
|
||||
& 1.1253954850882542_psb_dpk_, 1.1653553270075827_psb_dpk_, &
|
||||
& 1.2137919954743157_psb_dpk_, 1.2718635211544003_psb_dpk_, &
|
||||
& 1.3408502062615073_psb_dpk_, 1.4221696838526183_psb_dpk_, &
|
||||
& 1.5173934027630227_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000552858792859_psb_dpk_, 1.0005538659610900_psb_dpk_, &
|
||||
& 1.0019444166743086_psb_dpk_, 1.0046864301776393_psb_dpk_, &
|
||||
& 1.0092557508630260_psb_dpk_, 1.0161502674772371_psb_dpk_, &
|
||||
& 1.0258958148322650_psb_dpk_, 1.0390523408953256_psb_dpk_, &
|
||||
& 1.0562203973533295_psb_dpk_, 1.0780480145522537_psb_dpk_, &
|
||||
& 1.1052380250439366_psb_dpk_, 1.1385559038570177_psb_dpk_, &
|
||||
& 1.1788381980793483_psb_dpk_, 1.2270016234308427_psb_dpk_, &
|
||||
& 1.2840529112630572_psb_dpk_, 1.3510994958895055_psb_dpk_, &
|
||||
& 1.4293611393851839_psb_dpk_, 1.5201825990516680_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000472036358790_psb_dpk_, 1.0004728102642675_psb_dpk_, &
|
||||
& 1.0016593577469159_psb_dpk_, 1.0039976891368516_psb_dpk_, &
|
||||
& 1.0078911941833455_psb_dpk_, 1.0137601583069535_psb_dpk_, &
|
||||
& 1.0220462561721002_psb_dpk_, 1.0332172281153209_psb_dpk_, &
|
||||
& 1.0477717791157513_psb_dpk_, 1.0662447417325256_psb_dpk_, &
|
||||
& 1.0892125464929936_psb_dpk_, 1.1172990456131733_psb_dpk_, &
|
||||
& 1.1511817386833911_psb_dpk_, 1.1915984520803475_psb_dpk_, &
|
||||
& 1.2393545273929878_psb_dpk_, 1.2953305781018039_psb_dpk_, &
|
||||
& 1.3604908781568688_psb_dpk_, 1.4358924509939206_psb_dpk_, &
|
||||
& 1.5226949329440265_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000406232569254_psb_dpk_, 1.0004068351374691_psb_dpk_, &
|
||||
& 1.0014274431564170_psb_dpk_, 1.0034377175807407_psb_dpk_, &
|
||||
& 1.0067826854070978_psb_dpk_, 1.0118204999571436_psb_dpk_, &
|
||||
& 1.0189259121271075_psb_dpk_, 1.0284938700470616_psb_dpk_, &
|
||||
& 1.0409432748132981_psb_dpk_, 1.0567209210598594_psb_dpk_, &
|
||||
& 1.0763056524407055_psb_dpk_, 1.1002127636100871_psb_dpk_, &
|
||||
& 1.1289986820268283_psb_dpk_, 1.1632659648787138_psb_dpk_, &
|
||||
& 1.2036686486408621_psb_dpk_, 1.2509179912601627_psb_dpk_, &
|
||||
& 1.3057886497146727_psb_dpk_, 1.3691253387497200_psb_dpk_, &
|
||||
& 1.4418500199624611_psb_dpk_, 1.5249696741164267_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000352114440929_psb_dpk_, 1.0003525892395289_psb_dpk_, &
|
||||
& 1.0012368357172980_psb_dpk_, 1.0029777430511673_psb_dpk_, &
|
||||
& 1.0058727830027672_psb_dpk_, 1.0102297507781717_psb_dpk_, &
|
||||
& 1.0163694815733537_psb_dpk_, 1.0246286588536329_psb_dpk_, &
|
||||
& 1.0353627340015590_psb_dpk_, 1.0489489776835172_psb_dpk_, &
|
||||
& 1.0657896841306789_psb_dpk_, 1.0863155505114006_psb_dpk_, &
|
||||
& 1.1109892546943501_psb_dpk_, 1.1403092559728156_psb_dpk_, &
|
||||
& 1.1748138447471401_psb_dpk_, 1.2150854687543668_psb_dpk_, &
|
||||
& 1.2617553651999671_psb_dpk_, 1.3155085300984379_psb_dpk_, &
|
||||
& 1.3770890582780710_psb_dpk_, 1.4473058898645985_psb_dpk_, &
|
||||
& 1.5270390016420912_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000307198714835_psb_dpk_, 1.0003075769178242_psb_dpk_, &
|
||||
& 1.0010787281022711_psb_dpk_, 1.0025963829693492_psb_dpk_, &
|
||||
& 1.0051188625231162_psb_dpk_, 1.0089126974249720_psb_dpk_, &
|
||||
& 1.0142547789760521_psb_dpk_, 1.0214345766593154_psb_dpk_, &
|
||||
& 1.0307564364069204_psb_dpk_, 1.0425419742322541_psb_dpk_, &
|
||||
& 1.0571325804249445_psb_dpk_, 1.0748920501551993_psb_dpk_, &
|
||||
& 1.0962093570737961_psb_dpk_, 1.1215015873309027_psb_dpk_, &
|
||||
& 1.1512170523743910_psb_dpk_, 1.1858385999327761_psb_dpk_, &
|
||||
& 1.2258871437439198_psb_dpk_, 1.2719254338660289_psb_dpk_, &
|
||||
& 1.3245620908078453_psb_dpk_, 1.3844559282498121_psb_dpk_, &
|
||||
& 1.4523205908039656_psb_dpk_, 1.5289295350887884_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000269609460124_psb_dpk_, 1.0002699137181752_psb_dpk_, &
|
||||
& 1.0009464748475532_psb_dpk_, 1.0022775198638552_psb_dpk_, &
|
||||
& 1.0044888368184179_psb_dpk_, 1.0078128087804721_psb_dpk_, &
|
||||
& 1.0124901352066715_psb_dpk_, 1.0187716022931539_psb_dpk_, &
|
||||
& 1.0269199126829005_psb_dpk_, 1.0372115852204526_psb_dpk_, &
|
||||
& 1.0499389358225151_psb_dpk_, 1.0654121509688057_psb_dpk_, &
|
||||
& 1.0839614658147161_psb_dpk_, 1.1059394594887115_psb_dpk_, &
|
||||
& 1.1317234807654135_psb_dpk_, 1.1617182180038959_psb_dpk_, &
|
||||
& 1.1963584280123116_psb_dpk_, 1.2361118393501820_psb_dpk_, &
|
||||
& 1.2814822465106404_psb_dpk_, 1.3330128124440397_psb_dpk_, &
|
||||
& 1.3912895979940381_psb_dpk_, 1.4569453380258381_psb_dpk_, &
|
||||
& 1.5306634853375161_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000237911597230_psb_dpk_, 1.0002381585998457_psb_dpk_, &
|
||||
& 1.0008349974382460_psb_dpk_, 1.0020088476285827_psb_dpk_, &
|
||||
& 1.0039582343156432_psb_dpk_, 1.0068870298152559_psb_dpk_, &
|
||||
& 1.0110058445931565_psb_dpk_, 1.0165334547611182_psb_dpk_, &
|
||||
& 1.0236982737890488_psb_dpk_, 1.0327398763510158_psb_dpk_, &
|
||||
& 1.0439105824804926_psb_dpk_, 1.0574771105088172_psb_dpk_, &
|
||||
& 1.0737223076000839_psb_dpk_, 1.0929469670793606_psb_dpk_, &
|
||||
& 1.1154717421787756_psb_dpk_, 1.1416391663018148_psb_dpk_, &
|
||||
& 1.1718157904303341_psb_dpk_, 1.2063944488757254_psb_dpk_, &
|
||||
& 1.2457966652063013_psb_dpk_, 1.2904752108716941_psb_dpk_, &
|
||||
& 1.3409168297942540_psb_dpk_, 1.3976451430108305_psb_dpk_, &
|
||||
& 1.4612237483301715_psb_dpk_, 1.5322595309246121_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000210994601235_psb_dpk_, 1.0002111968041199_psb_dpk_, &
|
||||
& 1.0007403694573151_psb_dpk_, 1.0017808593384865_psb_dpk_, &
|
||||
& 1.0035081686576977_psb_dpk_, 1.0061021720448531_psb_dpk_, &
|
||||
& 1.0097482505685551_psb_dpk_, 1.0146384533048582_psb_dpk_, &
|
||||
& 1.0209726922414943_psb_dpk_, 1.0289599764553270_psb_dpk_, &
|
||||
& 1.0388196916802268_psb_dpk_, 1.0507829315895938_psb_dpk_, &
|
||||
& 1.0650938873538003_psb_dpk_, 1.0820113022982043_psb_dpk_, &
|
||||
& 1.1018099987843295_psb_dpk_, 1.1247824847650900_psb_dpk_, &
|
||||
& 1.1512406478277994_psb_dpk_, 1.1815175449359154_psb_dpk_, &
|
||||
& 1.2159692965153148_psb_dpk_, 1.2549770940040335_psb_dpk_, &
|
||||
& 1.2989493304988182_psb_dpk_, 1.3483238646890843_psb_dpk_, &
|
||||
& 1.4035704288718982_psb_dpk_, 1.4651931924923849_psb_dpk_, &
|
||||
& 1.5337334933563860_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000187989989242_psb_dpk_, 1.0001881567984481_psb_dpk_, &
|
||||
& 1.0006595227084085_psb_dpk_, 1.0015861311895899_psb_dpk_, &
|
||||
& 1.0031239047778964_psb_dpk_, 1.0054323694760092_psb_dpk_, &
|
||||
& 1.0086755868504005_psb_dpk_, 1.0130231071421940_psb_dpk_, &
|
||||
& 1.0186509477893992_psb_dpk_, 1.0257426018654052_psb_dpk_, &
|
||||
& 1.0344900810652515_psb_dpk_, 1.0450949980170887_psb_dpk_, &
|
||||
& 1.0577696928624343_psb_dpk_, 1.0727384092356933_psb_dpk_, &
|
||||
& 1.0902385249817814_psb_dpk_, 1.1105218431816117_psb_dpk_, &
|
||||
& 1.1338559493090710_psb_dpk_, 1.1605256406217599_psb_dpk_, &
|
||||
& 1.1908344341913664_psb_dpk_, 1.2251061603103259_psb_dpk_, &
|
||||
& 1.2636866483695495_psb_dpk_, 1.3069455126904677_psb_dpk_, &
|
||||
& 1.3552780462128098_psb_dpk_, 1.4091072303921326_psb_dpk_, &
|
||||
& 1.4688858701459975_psb_dpk_, 1.5350988632115488_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000168211938973_psb_dpk_, 1.0001683505351420_psb_dpk_, &
|
||||
& 1.0005900360142315_psb_dpk_, 1.0014188084960041_psb_dpk_, &
|
||||
& 1.0027938311393803_psb_dpk_, 1.0048572584314193_psb_dpk_, &
|
||||
& 1.0077550080990554_psb_dpk_, 1.0116375492127350_psb_dpk_, &
|
||||
& 1.0166607098595459_psb_dpk_, 1.0229865078405374_psb_dpk_, &
|
||||
& 1.0307840079371537_psb_dpk_, 1.0402302093961155_psb_dpk_, &
|
||||
& 1.0515109674005423_psb_dpk_, 1.0648219524284319_psb_dpk_, &
|
||||
& 1.0803696515480321_psb_dpk_, 1.0983724158638981_psb_dpk_, &
|
||||
& 1.1190615585080472_psb_dpk_, 1.1426825077681895_psb_dpk_, &
|
||||
& 1.1694960201606786_psb_dpk_, 1.1997794584895700_psb_dpk_, &
|
||||
& 1.2338281401870808_psb_dpk_, 1.2719567615042522_psb_dpk_, &
|
||||
& 1.3145009034164739_psb_dpk_, 1.3618186254259919_psb_dpk_, &
|
||||
& 1.4142921537855777_psb_dpk_, 1.4723296710339275_psb_dpk_, &
|
||||
& 1.5363672141264497_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000151113991291_psb_dpk_, 1.0001512299115287_psb_dpk_, &
|
||||
& 1.0005299814085029_psb_dpk_, 1.0012742317597600_psb_dpk_, &
|
||||
& 1.0025087130476142_psb_dpk_, 1.0043606572645858_psb_dpk_, &
|
||||
& 1.0069604400315522_psb_dpk_, 1.0104422369100252_psb_dpk_, &
|
||||
& 1.0149446949285030_psb_dpk_, 1.0206116219981500_psb_dpk_, &
|
||||
& 1.0275926969588451_psb_dpk_, 1.0360442030716124_psb_dpk_, &
|
||||
& 1.0461297878595799_psb_dpk_, 1.0580212522952626_psb_dpk_, &
|
||||
& 1.0718993724396861_psb_dpk_, 1.0879547567564958_psb_dpk_, &
|
||||
& 1.1063887424550545_psb_dpk_, 1.1274143343577541_psb_dpk_, &
|
||||
& 1.1512571899424711_psb_dpk_, 1.1781566543781672_psb_dpk_, &
|
||||
& 1.2083668495540898_psb_dpk_, 1.2421578212983135_psb_dpk_, &
|
||||
& 1.2798167491932815_psb_dpk_, 1.3216492236219661_psb_dpk_, &
|
||||
& 1.3679805949228399_psb_dpk_, 1.4191573997915068_psb_dpk_, &
|
||||
& 1.4755488703473389_psb_dpk_, 1.5375485315807513_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000136257096588_psb_dpk_, 1.0001363546506836_psb_dpk_, &
|
||||
& 1.0004778107488095_psb_dpk_, 1.0011486612681773_psb_dpk_, &
|
||||
& 1.0022611433613271_psb_dpk_, 1.0039295964948667_psb_dpk_, &
|
||||
& 1.0062710027404669_psb_dpk_, 1.0094055369479136_psb_dpk_, &
|
||||
& 1.0134571288503909_psb_dpk_, 1.0185540391932908_psb_dpk_, &
|
||||
& 1.0248294520252528_psb_dpk_, 1.0324220853457433_psb_dpk_, &
|
||||
& 1.0414768223656390_psb_dpk_, 1.0521453657079123_psb_dpk_, &
|
||||
& 1.0645869169533493_psb_dpk_, 1.0789688840227822_psb_dpk_, &
|
||||
& 1.0954676189818162_psb_dpk_, 1.1142691889576817_psb_dpk_, &
|
||||
& 1.1355701829701565_psb_dpk_, 1.1595785576006521_psb_dpk_, &
|
||||
& 1.1865145245551894_psb_dpk_, 1.2166114833191515_psb_dpk_, &
|
||||
& 1.2501170022543431_psb_dpk_, 1.2872938516530203_psb_dpk_, &
|
||||
& 1.3284210924391027_psb_dpk_, 1.3737952243949607_psb_dpk_, &
|
||||
& 1.4237313979931023_psb_dpk_, 1.4785646941265451_psb_dpk_, &
|
||||
& 1.5386514762605854_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000123285767939_psb_dpk_, 1.0001233683396147_psb_dpk_, &
|
||||
& 1.0004322711781202_psb_dpk_, 1.0010390719329101_psb_dpk_, &
|
||||
& 1.0020451337350940_psb_dpk_, 1.0035535979966428_psb_dpk_, &
|
||||
& 1.0056698406248343_psb_dpk_, 1.0085019360540697_psb_dpk_, &
|
||||
& 1.0121611307132341_psb_dpk_, 1.0167623275769953_psb_dpk_, &
|
||||
& 1.0224245834847208_psb_dpk_, 1.0292716209515502_psb_dpk_, &
|
||||
& 1.0374323562422998_psb_dpk_, 1.0470414455308106_psb_dpk_, &
|
||||
& 1.0582398510249318_psb_dpk_, 1.0711754290010183_psb_dpk_, &
|
||||
& 1.0860035417614331_psb_dpk_, 1.1028876956049132_psb_dpk_, &
|
||||
& 1.1220002069820316_psb_dpk_, 1.1435228990979547_psb_dpk_, &
|
||||
& 1.1676478313209715_psb_dpk_, 1.1945780638597872_psb_dpk_, &
|
||||
& 1.2245284602839432_psb_dpk_, 1.2577265305821996_psb_dpk_, &
|
||||
& 1.2944133175813315_psb_dpk_, 1.3348443296857557_psb_dpk_, &
|
||||
& 1.3792905230439911_psb_dpk_, 1.4280393364047606_psb_dpk_, &
|
||||
& 1.4813957820911738_psb_dpk_, 1.5396835966986973_psb_dpk_ ]
|
||||
|
||||
|
||||
|
||||
|
||||
!!$ [1.1250000000000000_psb_dpk_, 0.0_psb_dpk_, 0.0_psb_dpk__psb_dpk_,,&
|
||||
!!$ & 1.0238728757031315_psb_dpk_, 1.2640890537108553_psb_dpk_, 0.0_psb_dpk_,&
|
||||
!!$ & 1.0084254478202830_psb_dpk_, 1.0886783920873087_psb_dpk_, 1.3375312590961856_psb_dpk_]
|
||||
|
||||
real(psb_dpk_), parameter :: amg_d_poly_beta_mat(30,30)=reshape(amg_d_poly_beta_vect,[30,30])
|
||||
|
||||
end module amg_d_poly_coeff_mod
|
||||
@@ -1,374 +0,0 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Daniela di Serafino
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific 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_poly_smoother_mod.f90
|
||||
!
|
||||
! Module: amg_d_poly_smoother_mod
|
||||
!
|
||||
! This module defines:
|
||||
! the amg_d_poly_smoother_type data structure containing the
|
||||
! smoother for a Jacobi/block Jacobi smoother.
|
||||
! The smoother stores in ND the block off-diagonal matrix.
|
||||
! One special case is treated separately, when the solver is DIAG or L1-DIAG
|
||||
! then the ND is the entire off-diagonal part of the matrix (including the
|
||||
! main diagonal block), so that it becomes possible to implement
|
||||
! a pure Jacobi or L1-Jacobi global solver.
|
||||
!
|
||||
module amg_d_poly_smoother
|
||||
use amg_d_base_smoother_mod
|
||||
use amg_d_poly_coeff_mod
|
||||
|
||||
type, extends(amg_d_base_smoother_type) :: amg_d_poly_smoother_type
|
||||
! The local solver component is inherited from the
|
||||
! parent type.
|
||||
! class(amg_d_base_solver_type), allocatable :: sv
|
||||
!
|
||||
integer(psb_ipk_) :: pdegree, variant
|
||||
integer(psb_ipk_) :: rho_estimate=amg_poly_rho_est_power_
|
||||
integer(psb_ipk_) :: rho_estimate_iterations=10
|
||||
type(psb_dspmat_type), pointer :: pa => null()
|
||||
real(psb_dpk_), allocatable :: poly_beta(:)
|
||||
real(psb_dpk_) :: cf_a = dzero
|
||||
real(psb_dpk_) :: rho_ba = -done
|
||||
contains
|
||||
procedure, pass(sm) :: apply_v => amg_d_poly_smoother_apply_vect
|
||||
!!$ procedure, pass(sm) :: apply_a => amg_d_poly_smoother_apply
|
||||
procedure, pass(sm) :: dump => amg_d_poly_smoother_dmp
|
||||
procedure, pass(sm) :: build => amg_d_poly_smoother_bld
|
||||
procedure, pass(sm) :: cnv => amg_d_poly_smoother_cnv
|
||||
procedure, pass(sm) :: clone => amg_d_poly_smoother_clone
|
||||
procedure, pass(sm) :: clone_settings => amg_d_poly_smoother_clone_settings
|
||||
procedure, pass(sm) :: clear_data => amg_d_poly_smoother_clear_data
|
||||
procedure, pass(sm) :: free => d_poly_smoother_free
|
||||
procedure, pass(sm) :: cseti => amg_d_poly_smoother_cseti
|
||||
procedure, pass(sm) :: csetc => amg_d_poly_smoother_csetc
|
||||
procedure, pass(sm) :: csetr => amg_d_poly_smoother_csetr
|
||||
procedure, pass(sm) :: descr => amg_d_poly_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => d_poly_smoother_sizeof
|
||||
procedure, pass(sm) :: default => d_poly_smoother_default
|
||||
procedure, pass(sm) :: get_nzeros => d_poly_smoother_get_nzeros
|
||||
procedure, pass(sm) :: get_wrksz => d_poly_smoother_get_wrksize
|
||||
procedure, nopass :: get_fmt => d_poly_smoother_get_fmt
|
||||
procedure, nopass :: get_id => d_poly_smoother_get_id
|
||||
end type amg_d_poly_smoother_type
|
||||
private :: d_poly_smoother_free, &
|
||||
& d_poly_smoother_sizeof, d_poly_smoother_get_nzeros, &
|
||||
& d_poly_smoother_get_fmt, d_poly_smoother_get_id, &
|
||||
& d_poly_smoother_get_wrksize
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
& sweeps,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_
|
||||
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
integer(psb_ipk_), intent(in) :: sweeps
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_d_poly_smoother_apply_vect
|
||||
end interface
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine amg_d_poly_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
!!$ & sweeps,work,info,init,initu)
|
||||
!!$ import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
|
||||
!!$ & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
|
||||
!!$ & psb_ipk_
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
!!$ real(psb_dpk_),intent(inout) :: x(:)
|
||||
!!$ real(psb_dpk_),intent(inout) :: y(:)
|
||||
!!$ real(psb_dpk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ integer(psb_ipk_), intent(in) :: sweeps
|
||||
!!$ real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
!!$ end subroutine amg_d_poly_smoother_apply
|
||||
!!$ end interface
|
||||
!!$
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_poly_smoother_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_cnv(sm,info,amold,vmold,imold)
|
||||
import :: amg_d_poly_smoother_type, psb_dpk_, &
|
||||
& psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_poly_smoother_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, &
|
||||
& psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_poly_smoother_type), intent(in) :: sm
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: smoother, solver, global_num
|
||||
end subroutine amg_d_poly_smoother_dmp
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_clone(sm,smout,info)
|
||||
import :: amg_d_poly_smoother_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
class(amg_d_base_smoother_type), allocatable, intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_poly_smoother_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_clone_settings(sm,smout,info)
|
||||
import :: amg_d_poly_smoother_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
class(amg_d_base_smoother_type), intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_poly_smoother_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_clear_data(sm,info)
|
||||
import :: amg_d_poly_smoother_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_poly_smoother_clear_data
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: amg_d_poly_smoother_type, psb_ipk_
|
||||
class(amg_d_poly_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_d_poly_smoother_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_cseti(sm,what,val,info,idx)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_d_poly_smoother_cseti
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_csetc(sm,what,val,info,idx)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_d_poly_smoother_csetc
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_csetr(sm,what,val,info,idx)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_d_poly_smoother_csetr
|
||||
end interface
|
||||
|
||||
|
||||
contains
|
||||
|
||||
|
||||
subroutine d_poly_smoother_free(sm,info)
|
||||
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_poly_smoother_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
|
||||
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%free(info)
|
||||
if (info == psb_success_) deallocate(sm%sv,stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
end if
|
||||
if (allocated(sm%poly_beta)) deallocate(sm%poly_beta)
|
||||
sm%pa => null()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_poly_smoother_free
|
||||
|
||||
function d_poly_smoother_sizeof(sm) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_poly_smoother_type), intent(in) :: sm
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = psb_sizeof_dp
|
||||
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
|
||||
if (allocated(sm%poly_beta)) val = val + psb_sizeof_dp * size(sm%poly_beta)
|
||||
|
||||
return
|
||||
end function d_poly_smoother_sizeof
|
||||
|
||||
subroutine d_poly_smoother_default(sm)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
|
||||
!
|
||||
! Default: BJAC with no residual check
|
||||
!
|
||||
sm%pdegree = 1
|
||||
sm%rho_ba = -done
|
||||
sm%variant = amg_cheb_4_
|
||||
sm%rho_estimate = amg_poly_rho_est_power_
|
||||
sm%rho_estimate_iterations = 20
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%default()
|
||||
end if
|
||||
|
||||
return
|
||||
end subroutine d_poly_smoother_default
|
||||
|
||||
function d_poly_smoother_get_nzeros(sm) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_poly_smoother_type), intent(in) :: sm
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = 0
|
||||
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()
|
||||
|
||||
return
|
||||
end function d_poly_smoother_get_nzeros
|
||||
|
||||
function d_poly_smoother_get_wrksize(sm) result(val)
|
||||
implicit none
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = 4
|
||||
if (allocated(sm%sv)) val = val + sm%sv%get_wrksz()
|
||||
|
||||
end function d_poly_smoother_get_wrksize
|
||||
|
||||
function d_poly_smoother_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Polynomial smoother"
|
||||
end function d_poly_smoother_get_fmt
|
||||
|
||||
function d_poly_smoother_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_poly_
|
||||
end function d_poly_smoother_get_id
|
||||
|
||||
|
||||
end module amg_d_poly_smoother
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -40,7 +40,7 @@
|
||||
! Module: amg_d_prec_mod
|
||||
!
|
||||
! This module defines the user interfaces to the real/complex, single/double
|
||||
! precision versions of the user-level AMG4PSBLAS routines.
|
||||
! precision versions of the user-level MLD2P4 routines.
|
||||
!
|
||||
module amg_d_prec_mod
|
||||
|
||||
@@ -55,7 +55,12 @@ module amg_d_prec_mod
|
||||
use amg_d_ainv_solver
|
||||
use amg_d_invk_solver
|
||||
use amg_d_invt_solver
|
||||
use amg_d_krm_solver
|
||||
|
||||
interface amg_precset
|
||||
module procedure amg_d_iprecsetsm, amg_d_iprecsetsv, &
|
||||
& amg_d_cprecseti, amg_d_cprecsetc, amg_d_cprecsetr, &
|
||||
& amg_d_iprecsetag
|
||||
end interface amg_precset
|
||||
|
||||
interface amg_extprol_bld
|
||||
subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
|
||||
@@ -77,4 +82,61 @@ module amg_d_prec_mod
|
||||
end subroutine amg_d_extprol_bld
|
||||
end interface amg_extprol_bld
|
||||
|
||||
contains
|
||||
|
||||
subroutine amg_d_iprecsetsm(p,val,info,pos)
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
class(amg_d_base_smoother_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(val,info,pos=pos)
|
||||
end subroutine amg_d_iprecsetsm
|
||||
|
||||
subroutine amg_d_iprecsetsv(p,val,info,pos)
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
class(amg_d_base_solver_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
call p%set(val,info, pos=pos)
|
||||
end subroutine amg_d_iprecsetsv
|
||||
|
||||
subroutine amg_d_iprecsetag(p,val,info,pos)
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
class(amg_d_base_aggregator_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
call p%set(val,info, pos=pos)
|
||||
end subroutine amg_d_iprecsetag
|
||||
|
||||
subroutine amg_d_cprecseti(p,what,val,info,pos)
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_d_cprecseti
|
||||
|
||||
subroutine amg_d_cprecsetr(p,what,val,info,pos)
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_d_cprecsetr
|
||||
|
||||
subroutine amg_d_cprecsetc(p,what,val,info,pos)
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_d_cprecsetc
|
||||
|
||||
end module amg_d_prec_mod
|
||||
|
||||
+51
-166
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -66,7 +66,7 @@ module amg_d_prec_type
|
||||
!
|
||||
! This is the data type containing all the information about the multilevel
|
||||
! preconditioner ('d', 's', 'c' and 'z', according to the real/complex,
|
||||
! single/double precision version of AMG4PSBLAS).
|
||||
! single/double precision version of MLD2P4).
|
||||
! It consists of an array of 'one-level' intermediate data structures
|
||||
! of type amg_donelev_type, each containing the information needed to apply
|
||||
! the smoothing and the coarse-space correction at a generic level. RT is the
|
||||
@@ -102,7 +102,6 @@ module amg_d_prec_type
|
||||
! The multilevel hierarchy
|
||||
!
|
||||
type(amg_d_onelev_type), allocatable :: precv(:)
|
||||
integer(psb_ipk_) :: nlevs
|
||||
contains
|
||||
procedure, pass(prec) :: psb_d_apply2_vect => amg_d_apply2_vect
|
||||
procedure, pass(prec) :: psb_d_apply1_vect => amg_d_apply1_vect
|
||||
@@ -114,13 +113,11 @@ module amg_d_prec_type
|
||||
procedure, pass(prec) :: free => amg_d_prec_free
|
||||
procedure, pass(prec) :: allocate_wrk => amg_d_allocate_wrk
|
||||
procedure, pass(prec) :: free_wrk => amg_d_free_wrk
|
||||
procedure, pass(prec) :: deallocate_wrk => amg_d_free_wrk
|
||||
procedure, pass(prec) :: is_allocated_wrk => amg_d_is_allocated_wrk
|
||||
procedure, pass(prec) :: get_complexity => amg_d_get_compl
|
||||
procedure, pass(prec) :: cmp_complexity => amg_d_cmp_compl
|
||||
procedure, pass(prec) :: get_avg_cr => amg_d_get_avg_cr
|
||||
procedure, pass(prec) :: cmp_avg_cr => amg_d_cmp_avg_cr
|
||||
procedure, pass(prec) :: set_nlevs => amg_d_set_nlevs
|
||||
procedure, pass(prec) :: get_nlevs => amg_d_get_nlevs
|
||||
procedure, pass(prec) :: get_nzeros => amg_d_get_nzeros
|
||||
procedure, pass(prec) :: sizeof => amg_dprec_sizeof
|
||||
@@ -138,11 +135,8 @@ module amg_d_prec_type
|
||||
procedure, pass(prec) :: build => amg_dprecbld
|
||||
procedure, pass(prec) :: hierarchy_build => amg_d_hierarchy_bld
|
||||
procedure, pass(prec) :: hierarchy_rebuild => amg_d_hierarchy_rebld
|
||||
procedure, pass(prec) :: hierarchy_free => amg_d_hierarchy_free
|
||||
procedure, pass(prec) :: smoothers_build => amg_d_smoothers_bld
|
||||
procedure, pass(prec) :: smoothers_free => amg_d_smoothers_free
|
||||
procedure, pass(prec) :: descr => amg_dfile_prec_descr
|
||||
procedure, pass(prec) :: memory_use => amg_dfile_prec_memory_use
|
||||
end type amg_dprec_type
|
||||
|
||||
private :: amg_d_dump, amg_d_get_compl, amg_d_cmp_compl,&
|
||||
@@ -161,35 +155,16 @@ module amg_d_prec_type
|
||||
|
||||
|
||||
interface amg_precdescr
|
||||
subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity,prefix)
|
||||
subroutine amg_dfile_prec_descr(prec,iout,root)
|
||||
import :: amg_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_dfile_prec_descr
|
||||
end interface
|
||||
|
||||
|
||||
interface amg_memory_use
|
||||
subroutine amg_dfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
|
||||
import :: amg_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: global
|
||||
end subroutine amg_dfile_prec_memory_use
|
||||
end interface
|
||||
|
||||
interface amg_sizeof
|
||||
module procedure amg_dprec_sizeof
|
||||
end interface
|
||||
@@ -313,7 +288,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
|
||||
@@ -325,15 +300,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
|
||||
@@ -368,14 +342,6 @@ module amg_d_prec_type
|
||||
end subroutine amg_d_smoothers_bld
|
||||
end interface amg_smoothers_bld
|
||||
|
||||
interface amg_smoothers_free
|
||||
module procedure amg_d_smoothers_free
|
||||
end interface amg_smoothers_free
|
||||
|
||||
interface amg_hierarchy_free
|
||||
module procedure amg_d_hierarchy_free
|
||||
end interface amg_hierarchy_free
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -437,19 +403,10 @@ contains
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_) :: val
|
||||
val = 0
|
||||
!!$ if (allocated(prec%precv)) then
|
||||
!!$ val = size(prec%precv)
|
||||
!!$ end if
|
||||
val = prec%nlevs
|
||||
!!$ write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
|
||||
if (allocated(prec%precv)) then
|
||||
val = size(prec%precv)
|
||||
end if
|
||||
end function amg_d_get_nlevs
|
||||
|
||||
subroutine amg_d_set_nlevs(prec,nl)
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_) :: nl
|
||||
prec%nlevs = nl
|
||||
end subroutine amg_d_set_nlevs
|
||||
!
|
||||
! Function returning the size of the amg_prec_type data structure
|
||||
! in bytes or in number of nonzeros of the operator(s) involved.
|
||||
@@ -467,22 +424,11 @@ contains
|
||||
end if
|
||||
end function amg_d_get_nzeros
|
||||
|
||||
function amg_dprec_sizeof(prec, global) result(val)
|
||||
function amg_dprec_sizeof(prec) result(val)
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
logical, intent(in), optional :: global
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
|
||||
logical :: global_
|
||||
|
||||
if (present(global)) then
|
||||
global_ = global
|
||||
else
|
||||
global_ = .false.
|
||||
end if
|
||||
|
||||
val = 0
|
||||
val = val + psb_sizeof_ip
|
||||
if (allocated(prec%precv)) then
|
||||
@@ -490,11 +436,6 @@ contains
|
||||
val = val + prec%precv(i)%sizeof()
|
||||
end do
|
||||
end if
|
||||
if (global_) then
|
||||
ctxt = prec%ctxt
|
||||
call psb_sum(ctxt,val)
|
||||
end if
|
||||
|
||||
end function amg_dprec_sizeof
|
||||
|
||||
!
|
||||
@@ -520,7 +461,7 @@ contains
|
||||
|
||||
real(psb_dpk_) :: num, den, nmin
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: il,nl
|
||||
integer(psb_ipk_) :: il
|
||||
|
||||
num = -done
|
||||
den = done
|
||||
@@ -530,10 +471,7 @@ contains
|
||||
num = prec%precv(il)%base_a%get_nzeros()
|
||||
if (num >= dzero) then
|
||||
den = num
|
||||
nl = prec%get_nlevs()
|
||||
!!$ write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
|
||||
do il=2, nl
|
||||
!!$ write(0,*) ' ',il,associated(prec%precv(il)%base_a)
|
||||
do il=2,size(prec%precv)
|
||||
num = num + max(0,prec%precv(il)%base_a%get_nzeros())
|
||||
end do
|
||||
end if
|
||||
@@ -564,6 +502,7 @@ contains
|
||||
end function amg_d_get_avg_cr
|
||||
|
||||
subroutine amg_d_cmp_avg_cr(prec)
|
||||
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
|
||||
@@ -571,18 +510,17 @@ contains
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: il, nl, iam, np
|
||||
|
||||
|
||||
avgcr = dzero
|
||||
nl = prec%get_nlevs()
|
||||
do il=2,nl
|
||||
if (prec%precv(il)%base_desc%is_ok()) then
|
||||
ctxt = prec%precv(il)%base_desc%get_ctxt()
|
||||
call psb_info(ctxt,iam,np)
|
||||
if (iam >=0) avgcr = avgcr + max(dzero,prec%precv(il)%szratio)
|
||||
end if
|
||||
end do
|
||||
avgcr = avgcr / (nl-1)
|
||||
ctxt = prec%ctxt
|
||||
call psb_info(ctxt,iam,np)
|
||||
if (allocated(prec%precv)) then
|
||||
nl = size(prec%precv)
|
||||
do il=2,nl
|
||||
avgcr = avgcr + max(dzero,prec%precv(il)%szratio)
|
||||
end do
|
||||
avgcr = avgcr / (nl-1)
|
||||
end if
|
||||
call psb_sum(ctxt,avgcr)
|
||||
prec%ag_data%avg_cr = avgcr/np
|
||||
end subroutine amg_d_cmp_avg_cr
|
||||
@@ -600,7 +538,9 @@ contains
|
||||
! error code.
|
||||
!
|
||||
subroutine amg_dprecfree(p,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -626,7 +566,9 @@ contains
|
||||
end subroutine amg_dprecfree
|
||||
|
||||
subroutine amg_d_prec_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -646,11 +588,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
|
||||
@@ -662,64 +599,7 @@ contains
|
||||
|
||||
end subroutine amg_d_prec_free
|
||||
|
||||
subroutine amg_d_smoothers_free(prec,info)
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_d_smoothers_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,prec%get_nlevs()
|
||||
call prec%precv(i)%free_smoothers(info)
|
||||
end do
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_d_smoothers_free
|
||||
|
||||
subroutine amg_d_hierarchy_free(prec,info)
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_d_hierarchy_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
me=-1
|
||||
write(0,*) 'Missing implementation '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_d_hierarchy_free
|
||||
|
||||
!
|
||||
! Top level methods.
|
||||
@@ -785,6 +665,7 @@ contains
|
||||
|
||||
end subroutine amg_d_apply1_vect
|
||||
|
||||
|
||||
subroutine amg_d_apply2v(prec,x,y,desc_data,info,trans,work)
|
||||
implicit none
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
@@ -849,6 +730,7 @@ contains
|
||||
subroutine amg_d_dump(prec,info,istart,iend,iproc,prefix,head,&
|
||||
& ac,rp,smoother,solver,tprol,&
|
||||
& global_num)
|
||||
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -856,16 +738,17 @@ contains
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
|
||||
integer(psb_ipk_) :: i, j, il1, iln, lev
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
type(psb_ctxt_type) :: icontxt
|
||||
integer(psb_ipk_) :: iam, np, iproc_
|
||||
character(len=80) :: prefix_
|
||||
character(len=120) :: fname ! len should be at least 20 more than
|
||||
! len of prefix_
|
||||
|
||||
info = 0
|
||||
ctxt = prec%ctxt
|
||||
call psb_info(ctxt,iam,np)
|
||||
iln = prec%get_nlevs()
|
||||
icontxt = prec%ctxt
|
||||
call psb_info(icontxt,iam,np)
|
||||
|
||||
iln = size(prec%precv)
|
||||
if (present(istart)) then
|
||||
il1 = max(1,istart)
|
||||
else
|
||||
@@ -889,6 +772,7 @@ contains
|
||||
end subroutine amg_d_dump
|
||||
|
||||
subroutine amg_d_cnv(prec,info,amold,vmold,imold)
|
||||
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -900,7 +784,7 @@ contains
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,prec%get_nlevs()
|
||||
do i=1,size(prec%precv)
|
||||
if (info == psb_success_ ) &
|
||||
& call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
|
||||
end do
|
||||
@@ -909,6 +793,7 @@ contains
|
||||
end subroutine amg_d_cnv
|
||||
|
||||
subroutine amg_d_clone(prec,precout,info)
|
||||
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
class(psb_dprec_type), intent(inout) :: precout
|
||||
@@ -920,24 +805,24 @@ contains
|
||||
end subroutine amg_d_clone
|
||||
|
||||
subroutine amg_d_inner_clone(prec,precout,info)
|
||||
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
class(psb_dprec_type), target, intent(inout) :: precout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
! Local vars
|
||||
integer(psb_ipk_) :: i, j, ln, lev
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
type(psb_ctxt_type) :: icontxt
|
||||
integer(psb_ipk_) :: iam, np
|
||||
|
||||
info = psb_success_
|
||||
select type(pout => precout)
|
||||
class is (amg_dprec_type)
|
||||
pout%ctxt = prec%ctxt
|
||||
pout%ctxt = prec%ctxt
|
||||
pout%ag_data = prec%ag_data
|
||||
pout%outer_sweeps = prec%outer_sweeps
|
||||
pout%nlevs = prec%nlevs
|
||||
if (allocated(prec%precv)) then
|
||||
ln = prec%get_nlevs()
|
||||
ln = size(prec%precv)
|
||||
allocate(pout%precv(ln),stat=info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (ln >= 1) then
|
||||
@@ -945,13 +830,12 @@ contains
|
||||
end if
|
||||
do lev=2, ln
|
||||
if (info /= psb_success_) exit
|
||||
!!$ write(0,*) 'Inner_clone must be checked and reimplemented! '
|
||||
call prec%precv(lev)%clone(pout%precv(lev),info)
|
||||
if (info == psb_success_) then
|
||||
pout%precv(lev)%base_a => pout%precv(lev)%ac
|
||||
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
|
||||
pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
|
||||
pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
|
||||
pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
|
||||
pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
@@ -991,8 +875,8 @@ contains
|
||||
do i=2, size(b%precv)
|
||||
b%precv(i)%base_a => b%precv(i)%ac
|
||||
b%precv(i)%base_desc => b%precv(i)%desc_ac
|
||||
b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
|
||||
b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
|
||||
b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
|
||||
b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
|
||||
end do
|
||||
|
||||
else
|
||||
@@ -1010,7 +894,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
|
||||
@@ -1025,7 +909,7 @@ contains
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
nlev = prec%get_nlevs()
|
||||
nlev = size(prec%precv)
|
||||
level = 1
|
||||
do level = 1, nlev
|
||||
call prec%precv(level)%allocate_wrk(info,vmold=vmold)
|
||||
@@ -1048,6 +932,7 @@ contains
|
||||
subroutine amg_d_free_wrk(prec,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -1064,7 +949,7 @@ contains
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
nlev = prec%get_nlevs()
|
||||
nlev = size(prec%precv)
|
||||
do level = 1, nlev
|
||||
call prec%precv(level)%free_wrk(info)
|
||||
end do
|
||||
|
||||
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
@@ -23,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -55,14 +52,14 @@
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! 3. The name of the MLD2P4 group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific prior written permission.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
|
||||
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
|
||||
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
@@ -73,16 +70,16 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_d_krm_solver_mod.f90
|
||||
! File: amg_d_rkr_solver_mod.f90
|
||||
!
|
||||
! Module: amg_d_krm_solver_mod
|
||||
! Module: amg_d_rkr_solver_mod
|
||||
!
|
||||
module amg_d_krm_solver
|
||||
module amg_d_rkr_solver
|
||||
|
||||
use amg_d_base_solver_mod
|
||||
use amg_d_prec_type
|
||||
|
||||
type, extends(amg_d_base_solver_type) :: amg_d_krm_solver_type
|
||||
type, extends(amg_d_base_solver_type) :: amg_d_rkr_solver_type
|
||||
!
|
||||
logical :: global
|
||||
character(len=16) :: method, kprec, sub_solve
|
||||
@@ -97,46 +94,46 @@ module amg_d_krm_solver
|
||||
contains
|
||||
!
|
||||
!
|
||||
procedure, pass(sv) :: dump => d_krm_solver_dmp
|
||||
procedure, pass(sv) :: check => d_krm_solver_check
|
||||
procedure, pass(sv) :: clone => d_krm_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => d_krm_solver_clone_settings
|
||||
procedure, pass(sv) :: cnv => d_krm_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_d_krm_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_d_krm_solver_apply
|
||||
procedure, pass(sv) :: clear_data => d_krm_solver_clear_data
|
||||
procedure, pass(sv) :: free => d_krm_solver_free
|
||||
procedure, pass(sv) :: cseti => d_krm_solver_cseti
|
||||
procedure, pass(sv) :: csetc => d_krm_solver_csetc
|
||||
procedure, pass(sv) :: csetr => d_krm_solver_csetr
|
||||
procedure, pass(sv) :: sizeof => d_krm_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => d_krm_solver_get_nzeros
|
||||
!procedure, nopass :: get_id => d_krm_solver_get_id
|
||||
procedure, pass(sv) :: is_global => d_krm_solver_is_global
|
||||
procedure, nopass :: is_iterative => d_krm_solver_is_iterative
|
||||
procedure, pass(sv) :: dump => d_rkr_solver_dmp
|
||||
procedure, pass(sv) :: check => d_rkr_solver_check
|
||||
procedure, pass(sv) :: clone => d_rkr_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => d_rkr_solver_clone_settings
|
||||
procedure, pass(sv) :: cnv => d_rkr_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_d_rkr_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_d_rkr_solver_apply
|
||||
procedure, pass(sv) :: clear_data => d_rkr_solver_clear_data
|
||||
procedure, pass(sv) :: free => d_rkr_solver_free
|
||||
procedure, pass(sv) :: cseti => d_rkr_solver_cseti
|
||||
procedure, pass(sv) :: csetc => d_rkr_solver_csetc
|
||||
procedure, pass(sv) :: csetr => d_rkr_solver_csetr
|
||||
procedure, pass(sv) :: sizeof => d_rkr_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => d_rkr_solver_get_nzeros
|
||||
!procedure, nopass :: get_id => d_rkr_solver_get_id
|
||||
procedure, pass(sv) :: is_global => d_rkr_solver_is_global
|
||||
procedure, nopass :: is_iterative => d_rkr_solver_is_iterative
|
||||
|
||||
|
||||
!
|
||||
! These methods are specific for the new solver type
|
||||
! and therefore need to be overridden
|
||||
!
|
||||
procedure, pass(sv) :: descr => d_krm_solver_descr
|
||||
procedure, pass(sv) :: default => d_krm_solver_default
|
||||
procedure, pass(sv) :: build => amg_d_krm_solver_bld
|
||||
procedure, nopass :: get_fmt => d_krm_solver_get_fmt
|
||||
end type amg_d_krm_solver_type
|
||||
procedure, pass(sv) :: descr => d_rkr_solver_descr
|
||||
procedure, pass(sv) :: default => d_rkr_solver_default
|
||||
procedure, pass(sv) :: build => amg_d_rkr_solver_bld
|
||||
procedure, nopass :: get_fmt => d_rkr_solver_get_fmt
|
||||
end type amg_d_rkr_solver_type
|
||||
|
||||
|
||||
private :: d_krm_solver_get_fmt, d_krm_solver_descr, d_krm_solver_default
|
||||
private :: d_rkr_solver_get_fmt, d_rkr_solver_descr, d_rkr_solver_default
|
||||
|
||||
interface
|
||||
subroutine amg_d_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
subroutine amg_d_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
import :: psb_desc_type, amg_d_rkr_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
@@ -146,17 +143,17 @@ module amg_d_krm_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_d_krm_solver_apply_vect
|
||||
end subroutine amg_d_rkr_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
subroutine amg_d_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
import :: psb_desc_type, amg_d_rkr_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
@@ -165,24 +162,24 @@ module amg_d_krm_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_d_krm_solver_apply
|
||||
end subroutine amg_d_rkr_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
subroutine amg_d_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_d_rkr_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(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
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_krm_solver_bld
|
||||
end subroutine amg_d_rkr_solver_bld
|
||||
end interface
|
||||
|
||||
|
||||
@@ -190,12 +187,12 @@ contains
|
||||
|
||||
!
|
||||
!
|
||||
subroutine d_krm_solver_default(sv)
|
||||
subroutine d_rkr_solver_default(sv)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%method = 'bicgstab'
|
||||
sv%kprec = 'bjac'
|
||||
@@ -210,42 +207,42 @@ contains
|
||||
sv%global = .false.
|
||||
|
||||
return
|
||||
end subroutine d_krm_solver_default
|
||||
end subroutine d_rkr_solver_default
|
||||
|
||||
function d_krm_solver_get_nzeros(sv) result(val)
|
||||
function d_rkr_solver_get_nzeros(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_krm_solver_type), intent(in) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = sv%prec%get_nzeros()
|
||||
|
||||
return
|
||||
end function d_krm_solver_get_nzeros
|
||||
end function d_rkr_solver_get_nzeros
|
||||
|
||||
function d_krm_solver_sizeof(sv) result(val)
|
||||
function d_rkr_solver_sizeof(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_krm_solver_type), intent(in) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
|
||||
|
||||
return
|
||||
end function d_krm_solver_sizeof
|
||||
end function d_rkr_solver_sizeof
|
||||
|
||||
|
||||
subroutine d_krm_solver_check(sv,info)
|
||||
subroutine d_rkr_solver_check(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_krm_solver_check'
|
||||
character(len=20) :: name='d_rkr_solver_check'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -259,36 +256,36 @@ contains
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_krm_solver_check
|
||||
end subroutine d_rkr_solver_check
|
||||
|
||||
subroutine d_krm_solver_cseti(sv,what,val,info,idx)
|
||||
subroutine d_rkr_solver_cseti(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_krm_solver_cseti'
|
||||
character(len=20) :: name='d_rkr_solver_cseti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('KRM_IRST')
|
||||
case('RKR_IRST')
|
||||
sv%irst = val
|
||||
case('KRM_ISTOPC')
|
||||
case('RKR_ISTOPC')
|
||||
sv%istopc = val
|
||||
case('KRM_ITMAX')
|
||||
case('RKR_ITMAX')
|
||||
sv%itmax = val
|
||||
case('KRM_ITRACE')
|
||||
case('RKR_ITRACE')
|
||||
sv%itrace = val
|
||||
case('KRM_SUB_SOLVE')
|
||||
case('RKR_SUB_SOLVE')
|
||||
sv%i_sub_solve = val
|
||||
case('KRM_FILLIN')
|
||||
case('RKR_FILLIN')
|
||||
sv%fillin = val
|
||||
case default
|
||||
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
|
||||
@@ -299,33 +296,33 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_krm_solver_cseti
|
||||
end subroutine d_rkr_solver_cseti
|
||||
|
||||
subroutine d_krm_solver_csetc(sv,what,val,info,idx)
|
||||
subroutine d_rkr_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='d_krm_solver_csetc'
|
||||
character(len=20) :: name='d_rkr_solver_csetc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('KRM_METHOD')
|
||||
case('RKR_METHOD')
|
||||
sv%method = psb_toupper(trim(val))
|
||||
case('KRM_KPREC')
|
||||
case('RKR_KPREC')
|
||||
sv%kprec = psb_toupper(trim(val))
|
||||
case('KRM_SUB_SOLVE')
|
||||
case('RKR_SUB_SOLVE')
|
||||
sv%sub_solve = psb_toupper(trim(val))
|
||||
case('KRM_GLOBAL')
|
||||
case('RKR_GLOBAL')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('LOCAL','FALSE')
|
||||
sv%global = .false.
|
||||
@@ -348,26 +345,26 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_krm_solver_csetc
|
||||
end subroutine d_rkr_solver_csetc
|
||||
|
||||
subroutine d_krm_solver_csetr(sv,what,val,info,idx)
|
||||
subroutine d_rkr_solver_csetr(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_krm_solver_csetr'
|
||||
character(len=20) :: name='d_rkr_solver_csetr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('KRM_EPS')
|
||||
case('RKR_EPS')
|
||||
sv%eps = val
|
||||
case default
|
||||
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
|
||||
@@ -378,18 +375,18 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_krm_solver_csetr
|
||||
end subroutine d_rkr_solver_csetr
|
||||
|
||||
subroutine d_krm_solver_clear_data(sv,info)
|
||||
subroutine d_rkr_solver_clear_data(sv,info)
|
||||
use psb_base_mod, only : psb_exit
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: l_ctxt
|
||||
character(len=20) :: name='d_krm_solver_free'
|
||||
character(len=20) :: name='d_rkr_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -406,19 +403,19 @@ contains
|
||||
nullify(sv%a)
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
end subroutine d_krm_solver_clear_data
|
||||
end subroutine d_rkr_solver_clear_data
|
||||
|
||||
|
||||
subroutine d_krm_solver_free(sv,info)
|
||||
subroutine d_rkr_solver_free(sv,info)
|
||||
use psb_base_mod, only : psb_exit
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: l_ctxt
|
||||
character(len=20) :: name='d_krm_solver_free'
|
||||
character(len=20) :: name='d_rkr_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -427,31 +424,29 @@ contains
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
end subroutine d_krm_solver_free
|
||||
end subroutine d_rkr_solver_free
|
||||
|
||||
function d_krm_solver_get_fmt() result(val)
|
||||
function d_rkr_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "KRM solver"
|
||||
end function d_krm_solver_get_fmt
|
||||
val = "RKR solver"
|
||||
end function d_rkr_solver_get_fmt
|
||||
|
||||
subroutine d_krm_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_rkr_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_krm_solver_type), intent(in) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_krm_solver_descr'
|
||||
character(len=20), parameter :: name='amg_d_rkr_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -460,33 +455,34 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%global) then
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
|
||||
write(iout_,*) ' Recursive Krylov solver (global)'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
|
||||
write(iout_,*) ' Recursive Krylov solver (local) '
|
||||
end if
|
||||
write(iout_,*) trim(prefix_), ' method: ',sv%method
|
||||
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
|
||||
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
|
||||
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
|
||||
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
|
||||
write(iout_,*) ' method: ',sv%method
|
||||
write(iout_,*) ' kprec: ',sv%kprec
|
||||
if (sv%i_sub_solve > 0) then
|
||||
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
|
||||
else
|
||||
write(iout_,*) ' sub_solve: ',sv%sub_solve
|
||||
end if
|
||||
write(iout_,*) ' itmax: ',sv%itmax
|
||||
write(iout_,*) ' eps: ',sv%eps
|
||||
write(iout_,*) ' fillin: ',sv%fillin
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_krm_solver_descr
|
||||
end subroutine d_rkr_solver_descr
|
||||
|
||||
subroutine d_krm_solver_cnv(sv,info,amold,vmold,imold)
|
||||
subroutine d_rkr_solver_cnv(sv,info,amold,vmold,imold)
|
||||
implicit none
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
@@ -494,13 +490,13 @@ contains
|
||||
|
||||
call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
|
||||
|
||||
end subroutine d_krm_solver_cnv
|
||||
end subroutine d_rkr_solver_cnv
|
||||
|
||||
subroutine d_krm_solver_clone(sv,svout,info)
|
||||
subroutine d_rkr_solver_clone(sv,svout,info)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -509,7 +505,7 @@ contains
|
||||
call svout%free(info)
|
||||
allocate(svout,stat=info,mold=sv)
|
||||
select type(so=>svout)
|
||||
class is(amg_d_krm_solver_type)
|
||||
class is(amg_d_rkr_solver_type)
|
||||
so%method = sv%method
|
||||
so%kprec = sv%kprec
|
||||
so%sub_solve = sv%sub_solve
|
||||
@@ -528,21 +524,21 @@ contains
|
||||
info = psb_err_internal_error_
|
||||
end select
|
||||
|
||||
end subroutine d_krm_solver_clone
|
||||
end subroutine d_rkr_solver_clone
|
||||
|
||||
|
||||
subroutine d_krm_solver_clone_settings(sv,svout,info)
|
||||
subroutine d_rkr_solver_clone_settings(sv,svout,info)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type(so=>svout)
|
||||
class is(amg_d_krm_solver_type)
|
||||
class is(amg_d_rkr_solver_type)
|
||||
so%method = sv%method
|
||||
so%kprec = sv%kprec
|
||||
so%sub_solve = sv%sub_solve
|
||||
@@ -558,11 +554,11 @@ contains
|
||||
info = psb_err_internal_error_
|
||||
end select
|
||||
|
||||
end subroutine d_krm_solver_clone_settings
|
||||
end subroutine d_rkr_solver_clone_settings
|
||||
|
||||
subroutine d_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
subroutine d_rkr_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
implicit none
|
||||
class(amg_d_krm_solver_type), intent(in) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(in) :: sv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -572,23 +568,23 @@ contains
|
||||
|
||||
call sv%prec%dump(info,prefix=prefix,head=head)
|
||||
|
||||
end subroutine d_krm_solver_dmp
|
||||
end subroutine d_rkr_solver_dmp
|
||||
!
|
||||
! Notify whether KRM is used as a global solver
|
||||
! Notify whether RKR is used as a global solver
|
||||
!
|
||||
function d_krm_solver_is_global(sv) result(val)
|
||||
function d_rkr_solver_is_global(sv) result(val)
|
||||
implicit none
|
||||
class(amg_d_krm_solver_type), intent(in) :: sv
|
||||
class(amg_d_rkr_solver_type), intent(in) :: sv
|
||||
logical :: val
|
||||
|
||||
val = (sv%global)
|
||||
end function d_krm_solver_is_global
|
||||
end function d_rkr_solver_is_global
|
||||
!
|
||||
function d_krm_solver_is_iterative() result(val)
|
||||
function d_rkr_solver_is_iterative() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function d_krm_solver_is_iterative
|
||||
end function d_rkr_solver_is_iterative
|
||||
|
||||
end module amg_d_krm_solver
|
||||
end module amg_d_rkr_solver
|
||||
+214
-277
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -51,7 +51,7 @@ module amg_d_slu_solver
|
||||
use iso_c_binding
|
||||
use amg_d_base_solver_mod
|
||||
|
||||
#if defined(PSB_IPK8)
|
||||
#if defined(IPK8)
|
||||
|
||||
type, extends(amg_d_base_solver_type) :: amg_d_slu_solver_type
|
||||
|
||||
@@ -63,9 +63,9 @@ module amg_d_slu_solver
|
||||
type(c_ptr) :: lufactors=c_null_ptr
|
||||
integer(c_long_long) :: symbsize=0, numsize=0
|
||||
contains
|
||||
procedure, pass(sv) :: build => amg_d_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => amg_d_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => amg_d_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: build => d_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => d_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => d_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: free => d_slu_solver_free
|
||||
procedure, pass(sv) :: clear_data => d_slu_solver_clear_data
|
||||
procedure, pass(sv) :: descr => d_slu_solver_descr
|
||||
@@ -76,8 +76,9 @@ module amg_d_slu_solver
|
||||
end type amg_d_slu_solver_type
|
||||
|
||||
|
||||
private :: d_slu_solver_free, d_slu_solver_descr, &
|
||||
& d_slu_solver_sizeof, &
|
||||
private :: d_slu_solver_bld, d_slu_solver_apply, &
|
||||
& d_slu_solver_free, d_slu_solver_descr, &
|
||||
& d_slu_solver_sizeof, d_slu_solver_apply_vect, &
|
||||
& d_slu_solver_get_fmt, d_slu_solver_get_id, &
|
||||
& d_slu_solver_clear_data
|
||||
private :: d_slu_solver_finalize
|
||||
@@ -117,264 +118,207 @@ module amg_d_slu_solver
|
||||
end function amg_dslu_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
import amg_d_slu_solver_type
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), 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
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_slu_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_d_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_d_slu_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_d_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_d_slu_solver_apply
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
!!$ subroutine d_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
!!$ real(psb_dpk_),intent(inout) :: x(:)
|
||||
!!$ real(psb_dpk_),intent(inout) :: y(:)
|
||||
!!$ real(psb_dpk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
!!$
|
||||
!!$ integer :: n_row,n_col
|
||||
!!$ real(psb_dpk_), pointer :: ww(:)
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act
|
||||
!!$ character :: trans_
|
||||
!!$ character(len=20) :: name='d_slu_solver_apply'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$
|
||||
!!$ trans_ = psb_toupper(trans)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ case('T','C')
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ n_row = desc_data%get_local_rows()
|
||||
!!$ n_col = desc_data%get_local_cols()
|
||||
!!$
|
||||
!!$ if (n_col <= size(work)) then
|
||||
!!$ ww => work(1:n_col)
|
||||
!!$ else
|
||||
!!$ allocate(ww(n_col),stat=info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_alloc_request_
|
||||
!!$ call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
!!$ & a_err='real(psb_dpk_)')
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ ww(1:n_row) = x(1:n_row)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ info = amg_dslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('T')
|
||||
!!$ info = amg_dslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('C')
|
||||
!!$ info = amg_dslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_internal_error_, &
|
||||
!!$ & name,a_err='Invalid TRANS in ILU subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$
|
||||
!!$ if (info == psb_success_) &
|
||||
!!$ & call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
!!$
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ call psb_errpush(psb_err_internal_error_,&
|
||||
!!$ & name,a_err='Error in subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ if (n_col > size(work)) then
|
||||
!!$ deallocate(ww)
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine d_slu_solver_apply
|
||||
!!$
|
||||
!!$ subroutine d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,wv,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
!!$ type(psb_d_vect_type),intent(inout) :: x
|
||||
!!$ type(psb_d_vect_type),intent(inout) :: y
|
||||
!!$ real(psb_dpk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
!!$ type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
!!$
|
||||
!!$ integer :: err_act
|
||||
!!$ character(len=20) :: name='d_slu_solver_apply_vect'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ call x%v%sync()
|
||||
!!$ call y%v%sync()
|
||||
!!$ call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
!!$ call y%v%set_host()
|
||||
!!$ if (info /= 0) goto 9999
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine d_slu_solver_apply_vect
|
||||
!!$
|
||||
!!$ subroutine d_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
!!$
|
||||
!!$ use psb_base_mod
|
||||
!!$
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ 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, intent(out) :: info
|
||||
!!$ type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
!!$ class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
!!$ class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
!!$ class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
!!$ ! Local variables
|
||||
!!$ type(psb_dspmat_type) :: atmp
|
||||
!!$ type(psb_d_csc_sparse_mat) :: acsc
|
||||
!!$ type(psb_d_coo_sparse_mat) :: acoo
|
||||
!!$ integer :: n_row,n_col, nrow_a, nztota
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
!!$ character(len=20) :: name='d_slu_solver_bld', ch_err
|
||||
!!$
|
||||
!!$ info=psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ debug_unit = psb_get_debug_unit()
|
||||
!!$ debug_level = psb_get_debug_level()
|
||||
!!$ ctxt = desc_a%get_context()
|
||||
!!$ call psb_info(ctxt, me, np)
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' start'
|
||||
!!$
|
||||
!!$
|
||||
!!$ n_row = desc_a%get_local_rows()
|
||||
!!$ n_col = desc_a%get_local_cols()
|
||||
!!$
|
||||
!!$
|
||||
!!$ call a%cscnv(atmp,info,type='coo')
|
||||
!!$ call psb_rwextd(n_row,atmp,info,b=b)
|
||||
!!$ call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
!!$ nrow_a = atmp%get_nrows()
|
||||
!!$ call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
!!$ call acsc%mv_from_coo(acoo,info)
|
||||
!!$ nztota = acsc%get_nzeros()
|
||||
!!$ ! Fix the entries to call C-base SuperLU
|
||||
!!$ acsc%ia(:) = acsc%ia(:) - 1
|
||||
!!$ acsc%icp(:) = acsc%icp(:) - 1
|
||||
!!$ info = amg_dslu_fact(nrow_a,nztota,acsc%val,&
|
||||
!!$ & acsc%icp,acsc%ia,sv%lufactors)
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_from_subroutine_
|
||||
!!$ ch_err='amg_dslu_fact'
|
||||
!!$ call psb_errpush(info,name,a_err=ch_err)
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ call acsc%free()
|
||||
!!$ call atmp%free()
|
||||
!!$
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' end'
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$ end subroutine d_slu_solver_bld
|
||||
subroutine d_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
real(psb_dpk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='d_slu_solver_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
trans_ = psb_toupper(trans)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
case('T','C')
|
||||
case default
|
||||
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
goto 9999
|
||||
end select
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
n_row = desc_data%get_local_rows()
|
||||
n_col = desc_data%get_local_cols()
|
||||
|
||||
if (n_col <= size(work)) then
|
||||
ww => work(1:n_col)
|
||||
else
|
||||
allocate(ww(n_col),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_alloc_request_
|
||||
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
& a_err='real(psb_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
ww(1:n_row) = x(1:n_row)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_dslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('T')
|
||||
info = amg_dslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('C')
|
||||
info = amg_dslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
case default
|
||||
call psb_errpush(psb_err_internal_error_, &
|
||||
& name,a_err='Invalid TRANS in ILU subsolve')
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
if (info == psb_success_) &
|
||||
& call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,&
|
||||
& name,a_err='Error in subsolve')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (n_col > size(work)) then
|
||||
deallocate(ww)
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_slu_solver_apply
|
||||
|
||||
subroutine d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='d_slu_solver_apply_vect'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
call x%v%sync()
|
||||
call y%v%sync()
|
||||
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
call y%v%set_host()
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_slu_solver_apply_vect
|
||||
|
||||
subroutine d_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
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, intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_dspmat_type) :: atmp
|
||||
type(psb_d_csc_sparse_mat) :: acsc
|
||||
type(psb_d_coo_sparse_mat) :: acoo
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_slu_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||
|
||||
|
||||
n_row = desc_a%get_local_rows()
|
||||
n_col = desc_a%get_local_cols()
|
||||
|
||||
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
nrow_a = atmp%get_nrows()
|
||||
call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
call acsc%mv_from_coo(acoo,info)
|
||||
nztota = acsc%get_nzeros()
|
||||
! Fix the entries to call C-base SuperLU
|
||||
acsc%ia(:) = acsc%ia(:) - 1
|
||||
acsc%icp(:) = acsc%icp(:) - 1
|
||||
info = amg_dslu_fact(nrow_a,nztota,acsc%val,&
|
||||
& acsc%icp,acsc%ia,sv%lufactors)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='amg_dslu_fact'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acsc%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_slu_solver_bld
|
||||
|
||||
subroutine d_slu_solver_free(sv,info)
|
||||
|
||||
@@ -441,22 +385,20 @@ contains
|
||||
|
||||
end subroutine d_slu_solver_finalize
|
||||
|
||||
subroutine d_slu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_slu_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_slu_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
character(len=20), parameter :: name='amg_d_slu_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -465,13 +407,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
|
||||
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -52,7 +52,7 @@ module amg_d_sludist_solver
|
||||
use iso_c_binding
|
||||
use amg_d_base_solver_mod
|
||||
|
||||
#if (!defined(AMG_HAVE_SLUDIST)) || defined(PSB_IPK8)
|
||||
#if defined(LPK8)
|
||||
|
||||
type, extends(amg_d_base_solver_type) :: amg_d_sludist_solver_type
|
||||
|
||||
@@ -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
|
||||
@@ -270,12 +270,10 @@ contains
|
||||
! Local variables
|
||||
type(psb_dspmat_type) :: atmp
|
||||
type(psb_d_csr_sparse_mat) :: acsr
|
||||
integer :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
|
||||
integer :: ifrst, ibcheck
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_lpk_), allocatable :: gia(:), gja(:)
|
||||
integer(psb_lpk_) :: lfrst
|
||||
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
|
||||
integer(psb_ipk_) :: ifrst, ibcheck
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_sludist_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
@@ -295,36 +293,19 @@ contains
|
||||
n_col = desc_a%get_local_cols()
|
||||
nglob = desc_a%get_global_rows()
|
||||
|
||||
!
|
||||
! Strategy here is as follows: because a call to SLUDIST
|
||||
! as a gobal solver is mostly done at the coarsest level,
|
||||
! even if we start from a problem requiring 8 bytes, chances
|
||||
! are that the global size will be suitable for 4 bytes
|
||||
! anyway, so we hope for the best, and throw an error
|
||||
! if something goes wrong.
|
||||
!
|
||||
if (nglob > huge(1_psb_ipk_)) then
|
||||
write(0,*) me,' ',trim(name),': Error: overflow of local indices '
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call a%cscnv(atmp,info,type='csr')
|
||||
! This in case we are dealing with AS
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='csr',dupl=psb_dupl_add_)
|
||||
call atmp%mv_to(acsr)
|
||||
nrow_a = acsr%get_nrows()
|
||||
nztota = acsr%get_nzeros()
|
||||
call psb_loc_to_glob(ione,lfrst,desc_a,info)
|
||||
|
||||
! Fix the entries to call C-base SuperLU
|
||||
call psb_realloc(nztota,gja,info)
|
||||
call psb_loc_to_glob(acsr%ja(1:nztota),gja(1:nztota), desc_a, info, iact='I')
|
||||
acsr%ja(1:nztota) = gja(1:nztota)
|
||||
call psb_loc_to_glob(1,ifrst,desc_a,info)
|
||||
call psb_loc_to_glob(nrow_a,ibcheck,desc_a,info)
|
||||
call psb_loc_to_glob(acsr%ja(1:nztota),desc_a,info,iact='I')
|
||||
acsr%ja(:) = acsr%ja(:) - 1
|
||||
acsr%irp(:) = acsr%irp(:) - 1
|
||||
ifrst = lfrst - 1
|
||||
ifrst = ifrst - 1
|
||||
info = amg_dsludist_fact(nglob,nrow_a,nztota,ifrst,&
|
||||
& acsr%val,acsr%irp,acsr%ja,sv%lufactors,&
|
||||
& npr,npc)
|
||||
@@ -337,6 +318,7 @@ contains
|
||||
end if
|
||||
|
||||
call acsr%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
@@ -421,16 +403,15 @@ contains
|
||||
|
||||
end subroutine d_sludist_solver_finalize
|
||||
|
||||
subroutine d_sludist_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_sludist_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_sludist_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
@@ -438,7 +419,6 @@ contains
|
||||
integer :: me, np
|
||||
character(len=20), parameter :: name='amg_d_sludist_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -447,13 +427,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' SuperLU_Dist Sparse Factorization Solver. '
|
||||
write(iout_,*) ' SuperLU_Dist Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -88,25 +88,16 @@ contains
|
||||
val = "Symmetric Decoupled aggregation"
|
||||
end function amg_d_symdec_aggregator_fmt
|
||||
|
||||
subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_d_symdec_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
character(1024) :: prefix_
|
||||
info = psb_success_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_d_symdec_aggregator_descr
|
||||
|
||||
+215
-78
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -51,7 +51,7 @@ module amg_d_umf_solver
|
||||
use iso_c_binding
|
||||
use amg_d_base_solver_mod
|
||||
|
||||
#if defined(PSB_IPK8)
|
||||
#if defined(IPK8)
|
||||
type, extends(amg_d_base_solver_type) :: amg_d_umf_solver_type
|
||||
|
||||
end type amg_d_umf_solver_type
|
||||
@@ -62,9 +62,9 @@ module amg_d_umf_solver
|
||||
type(c_ptr) :: symbolic=c_null_ptr, numeric=c_null_ptr
|
||||
integer(c_long_long) :: symbsize=0, numsize=0
|
||||
contains
|
||||
procedure, pass(sv) :: build => amg_d_umf_solver_bld
|
||||
procedure, pass(sv) :: apply_a => amg_d_umf_solver_apply
|
||||
procedure, pass(sv) :: apply_v => amg_d_umf_solver_apply_vect
|
||||
procedure, pass(sv) :: build => d_umf_solver_bld
|
||||
procedure, pass(sv) :: apply_a => d_umf_solver_apply
|
||||
procedure, pass(sv) :: apply_v => d_umf_solver_apply_vect
|
||||
procedure, pass(sv) :: free => d_umf_solver_free
|
||||
procedure, pass(sv) :: clear_data => d_umf_solver_clear_data
|
||||
procedure, pass(sv) :: descr => d_umf_solver_descr
|
||||
@@ -75,8 +75,9 @@ module amg_d_umf_solver
|
||||
end type amg_d_umf_solver_type
|
||||
|
||||
|
||||
private :: d_umf_solver_free, d_umf_solver_descr, &
|
||||
& d_umf_solver_sizeof, &
|
||||
private :: d_umf_solver_bld, d_umf_solver_apply, &
|
||||
& d_umf_solver_free, d_umf_solver_descr, &
|
||||
& d_umf_solver_sizeof, d_umf_solver_apply_vect, &
|
||||
& d_umf_solver_get_fmt, d_umf_solver_get_id, &
|
||||
& d_umf_solver_clear_data
|
||||
private :: d_umf_solver_finalize
|
||||
@@ -117,65 +118,208 @@ module amg_d_umf_solver
|
||||
end function amg_dumf_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_d_umf_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_d_umf_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_d_umf_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_d_umf_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
import amg_d_umf_solver_type
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(inout), 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
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_umf_solver_bld
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
real(psb_dpk_), pointer :: ww(:)
|
||||
integer(psb_ipk_) :: i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='d_umf_solver_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
trans_ = psb_toupper(trans)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
case('T','C')
|
||||
case default
|
||||
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
goto 9999
|
||||
end select
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
n_row = desc_data%get_local_rows()
|
||||
n_col = desc_data%get_local_cols()
|
||||
|
||||
if (n_col <= size(work)) then
|
||||
ww => work(1:n_col)
|
||||
else
|
||||
allocate(ww(n_col),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_alloc_request_
|
||||
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
& a_err='real(psb_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_dumf_solve(0,n_row,ww,x,n_row,sv%numeric)
|
||||
case('T')
|
||||
!
|
||||
! Note: with UMF, 1 meand Ctranspose, 2 means transpose
|
||||
! even for complex data.
|
||||
!
|
||||
if (psb_d_is_complex_) then
|
||||
info = amg_dumf_solve(2,n_row,ww,x,n_row,sv%numeric)
|
||||
else
|
||||
info = amg_dumf_solve(1,n_row,ww,x,n_row,sv%numeric)
|
||||
end if
|
||||
case('C')
|
||||
info = amg_dumf_solve(1,n_row,ww,x,n_row,sv%numeric)
|
||||
case default
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
if (info == psb_success_) call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (n_col > size(work)) then
|
||||
deallocate(ww)
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_umf_solver_apply
|
||||
|
||||
subroutine d_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='d_umf_solver_apply_vect'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
call x%v%sync()
|
||||
call y%v%sync()
|
||||
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
call y%v%set_host()
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_umf_solver_apply_vect
|
||||
|
||||
subroutine d_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
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, intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_dspmat_type) :: atmp
|
||||
type(psb_d_csc_sparse_mat) :: acsc
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_umf_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||
|
||||
|
||||
n_row = desc_a%get_local_rows()
|
||||
n_col = desc_a%get_local_cols()
|
||||
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='csc',dupl=psb_dupl_add_)
|
||||
call atmp%mv_to(acsc)
|
||||
nrow_a = acsc%get_nrows()
|
||||
nztota = acsc%get_nzeros()
|
||||
! Fix the entres to call C-base UMFPACK.
|
||||
acsc%ia(:) = acsc%ia(:) - 1
|
||||
acsc%icp(:) = acsc%icp(:) - 1
|
||||
info = amg_dumf_fact(nrow_a,nztota,acsc%val,&
|
||||
& acsc%ia,acsc%icp,sv%symbolic,sv%numeric,&
|
||||
& sv%symbsize,sv%numsize)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='amg_dumf_fact'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acsc%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_umf_solver_bld
|
||||
|
||||
subroutine d_umf_solver_free(sv,info)
|
||||
|
||||
@@ -246,22 +390,20 @@ contains
|
||||
|
||||
end subroutine d_umf_solver_finalize
|
||||
|
||||
subroutine d_umf_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_umf_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_umf_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
character(len=20), parameter :: name='amg_d_umf_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -270,13 +412,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' UMFPACK Sparse Factorization Solver. '
|
||||
write(iout_,*) ' UMFPACK Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -40,7 +40,7 @@
|
||||
! Module: amg_prec_mod
|
||||
!
|
||||
! This module defines the interfaces to the real/complex, single/double
|
||||
! precision versions of the user-level AMG4PSBLAS routines.
|
||||
! precision versions of the user-level MLD2P4 routines.
|
||||
!
|
||||
module amg_prec_mod
|
||||
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
@@ -20,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -58,10 +55,13 @@ module amg_s_ainv_solver
|
||||
procedure, pass(sv) :: check => amg_s_ainv_solver_check
|
||||
procedure, pass(sv) :: build => amg_s_ainv_solver_bld
|
||||
procedure, pass(sv) :: clone => amg_s_ainv_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_s_ainv_solver_clone_settings
|
||||
procedure, pass(sv) :: cseti => amg_s_ainv_solver_cseti
|
||||
procedure, pass(sv) :: csetc => amg_s_ainv_solver_csetc
|
||||
procedure, pass(sv) :: csetr => amg_s_ainv_solver_csetr
|
||||
procedure, pass(sv) :: seti => amg_s_ainv_solver_seti
|
||||
procedure, pass(sv) :: setc => amg_s_ainv_solver_setc
|
||||
procedure, pass(sv) :: setr => amg_s_ainv_solver_setr
|
||||
generic, public :: set => seti, setr, setc
|
||||
procedure, pass(sv) :: descr => amg_s_ainv_solver_descr
|
||||
procedure, pass(sv) :: default => s_ainv_solver_default
|
||||
procedure, nopass :: stringval => s_ainv_stringval
|
||||
@@ -83,16 +83,6 @@ module amg_s_ainv_solver
|
||||
end subroutine amg_s_ainv_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& amg_s_base_solver_type, psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_ainv_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
@@ -103,7 +93,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
|
||||
@@ -169,44 +159,44 @@ module amg_s_ainv_solver
|
||||
end subroutine amg_s_ainv_solver_csetr
|
||||
end interface
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine amg_s_ainv_solver_setc(sv,what,val,info)
|
||||
!!$ import :: amg_s_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ character(len=*), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_s_ainv_solver_setc
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_s_ainv_solver_seti(sv,what,val,info)
|
||||
!!$ import :: amg_s_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ integer(psb_ipk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_s_ainv_solver_seti
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_s_ainv_solver_setr(sv,what,val,info)
|
||||
!!$ import :: amg_s_ainv_solver_type, psb_ipk_, psb_spk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ real(psb_spk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_s_ainv_solver_setr
|
||||
!!$ end interface
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_setc(sv,what,val,info)
|
||||
import :: amg_s_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_ainv_solver_setc
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_s_ainv_solver_seti(sv,what,val,info)
|
||||
import :: amg_s_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_ainv_solver_seti
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_setr(sv,what,val,info)
|
||||
import :: amg_s_ainv_solver_type, psb_ipk_, psb_spk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_ainv_solver_setr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -216,7 +206,7 @@ module amg_s_ainv_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_s_ainv_solver_descr
|
||||
end interface
|
||||
|
||||
@@ -225,7 +215,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
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -396,23 +396,21 @@ contains
|
||||
end subroutine s_as_smoother_default
|
||||
|
||||
|
||||
subroutine s_as_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine s_as_smoother_descr(sm,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_as_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_as_smoother_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
logical :: coarse_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -426,21 +424,16 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (.not.coarse_) then
|
||||
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
|
||||
write(iout_,*) ' Additive Schwarz with ',&
|
||||
& sm%novr, ' overlap layers.'
|
||||
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) trim(prefix_), ' Local solver:'
|
||||
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) ' Local solver:'
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
|
||||
call sm%sv%descr(info,iout_,coarse=coarse)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -89,7 +89,7 @@ module amg_s_base_aggregator_mod
|
||||
procedure, pass(ag) :: bld_tprol => amg_s_base_aggregator_build_tprol
|
||||
procedure, pass(ag) :: mat_bld => amg_s_base_aggregator_mat_bld
|
||||
procedure, pass(ag) :: mat_asb => amg_s_base_aggregator_mat_asb
|
||||
procedure, pass(ag) :: bld_linmap => amg_s_base_aggregator_bld_linmap
|
||||
procedure, pass(ag) :: bld_map => amg_s_base_aggregator_bld_map
|
||||
procedure, pass(ag) :: update_next => amg_s_base_aggregator_update_next
|
||||
procedure, pass(ag) :: clone => amg_s_base_aggregator_clone
|
||||
procedure, pass(ag) :: free => amg_s_base_aggregator_free
|
||||
@@ -126,7 +126,7 @@ module amg_s_base_aggregator_mod
|
||||
& psb_s_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_s_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_s_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -144,7 +144,7 @@ module amg_s_base_aggregator_mod
|
||||
& psb_s_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_s_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_s_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -275,22 +275,15 @@ contains
|
||||
val = .false.
|
||||
end function amg_s_base_aggregator_xt_desc
|
||||
|
||||
subroutine amg_s_base_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_s_base_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_s_base_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_s_base_aggregator_descr
|
||||
@@ -302,7 +295,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Do nothing
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
end subroutine amg_s_base_aggregator_set_aggr_type
|
||||
|
||||
@@ -458,7 +451,7 @@ contains
|
||||
end subroutine amg_s_base_aggregator_mat_asb
|
||||
|
||||
!
|
||||
!> Function bld_linmap
|
||||
!> Function bld_map
|
||||
!! \memberof amg_s_base_aggregator_type
|
||||
!! \brief Build linear map between hierarchy levels
|
||||
!!
|
||||
@@ -473,7 +466,7 @@ contains
|
||||
!! \param map The output map
|
||||
!! \param info Return code
|
||||
!!
|
||||
subroutine amg_s_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
subroutine amg_s_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
@@ -484,9 +477,8 @@ contains
|
||||
type(psb_slinmap_type), intent(out) :: map
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_base_aggregator_bld_linmap'
|
||||
character(len=20) :: name='s_base_aggregator_bld_map'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
!
|
||||
! Copy the prolongation/restriction matrices into the descriptor map.
|
||||
@@ -508,6 +500,7 @@ contains
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine amg_s_base_aggregator_bld_linmap
|
||||
end subroutine amg_s_base_aggregator_bld_map
|
||||
|
||||
|
||||
end module amg_s_base_aggregator_mod
|
||||
|
||||
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
@@ -20,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -272,7 +272,7 @@ module amg_s_base_smoother_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_base_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_s_base_smoother_descr(sm,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_base_smoother_type, psb_ipk_
|
||||
@@ -281,7 +281,6 @@ module amg_s_base_smoother_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_s_base_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -270,7 +270,7 @@ module amg_s_base_solver_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_base_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_s_base_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_base_solver_type, psb_ipk_
|
||||
@@ -281,7 +281,7 @@ module amg_s_base_solver_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_s_base_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -150,7 +150,7 @@ contains
|
||||
class(amg_s_dec_aggregator_type), intent(inout) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
info = psb_success_
|
||||
|
||||
select case(parms%aggr_type)
|
||||
case (amg_noalg_)
|
||||
ag%soc_map_bld => null()
|
||||
@@ -184,24 +184,16 @@ contains
|
||||
val = "Decoupled aggregation"
|
||||
end function amg_s_dec_aggregator_fmt
|
||||
|
||||
subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_s_dec_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
info = psb_success_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Decoupled Aggregator'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_s_dec_aggregator_descr
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -219,7 +219,7 @@ contains
|
||||
|
||||
end subroutine s_diag_solver_free
|
||||
|
||||
subroutine s_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -228,13 +228,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -242,13 +240,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Diagonal local solver '
|
||||
|
||||
write(iout_,*) ' Diagonal local solver '
|
||||
|
||||
return
|
||||
|
||||
@@ -331,7 +324,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
|
||||
@@ -359,7 +352,7 @@ module amg_s_l1_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
subroutine s_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_l1_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -368,13 +361,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_l1_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -382,13 +373,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
|
||||
|
||||
write(iout_,*) ' L1 Diagonal solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
+17
-31
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -433,22 +433,20 @@ contains
|
||||
return
|
||||
end subroutine s_gs_solver_free
|
||||
|
||||
subroutine s_gs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_gs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_gs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_gs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -457,17 +455,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
@@ -533,22 +526,20 @@ contains
|
||||
val = .true.
|
||||
end function s_gs_solver_is_iterative
|
||||
|
||||
subroutine s_bwgs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_bwgs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_bwgs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_bwgs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -557,17 +548,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
|
||||
@@ -0,0 +1,125 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
|
||||
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
! POSSIBILITY OF SUCH DAMAGE.
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! The aggregator object hosts the aggregation method for building
|
||||
! the multilevel hierarchy. This variant is based on the hybrid method
|
||||
! presented in
|
||||
!
|
||||
! S. Gratton, P. Henon, P. Jiranek and X. Vasseur:
|
||||
! Reducing complexity of algebraic multigrid by aggregation
|
||||
! Numerical Lin. Algebra with Applications, 2016, 23:501-518
|
||||
!
|
||||
module amg_s_hybrid_aggregator_mod
|
||||
|
||||
use amg_s_dec_aggregator_mod
|
||||
!
|
||||
! sm - class(amg_T_base_smoother_type), allocatable
|
||||
! The current level preconditioner (aka smoother).
|
||||
! parms - type(amg_RTml_parms)
|
||||
! The parameters defining the multilevel strategy.
|
||||
! ac - The local part of the current-level matrix, built by
|
||||
! coarsening the previous-level matrix.
|
||||
! desc_ac - type(psb_desc_type).
|
||||
! The communication descriptor associated to the matrix
|
||||
! stored in ac.
|
||||
! base_a - type(psb_Tspmat_type), pointer.
|
||||
! Pointer (really a pointer!) to the local part of the current
|
||||
! matrix (so we have a unified treatment of residuals).
|
||||
! We need this to avoid passing explicitly the current matrix
|
||||
! to the routine which applies the preconditioner.
|
||||
! base_desc - type(psb_desc_type), pointer.
|
||||
! Pointer to the communication descriptor associated to the
|
||||
! matrix pointed by base_a.
|
||||
! map - Stores the maps (restriction and prolongation) between the
|
||||
! vector spaces associated to the index spaces of the previous
|
||||
! and current levels.
|
||||
!
|
||||
! Methods:
|
||||
! Most methods follow the encapsulation hierarchy: they take whatever action
|
||||
! is appropriate for the current object, then call the corresponding method for
|
||||
! the contained object.
|
||||
! As an example: the descr() method prints out a description of the
|
||||
! level. It starts by invoking the descr() method of the parms object,
|
||||
! then calls the descr() method of the smoother object.
|
||||
!
|
||||
! descr - Prints a description of the object.
|
||||
! default - Set default values
|
||||
! dump - Dump to file object contents
|
||||
! set - Sets various parameters; when a request is unknown
|
||||
! it is passed to the smoother object for further processing.
|
||||
! check - Sanity checks.
|
||||
! sizeof - Total memory occupation in bytes
|
||||
! get_nzeros - Number of nonzeros
|
||||
!
|
||||
!
|
||||
type, extends(amg_s_dec_aggregator_type) :: amg_s_hybrid_aggregator_type
|
||||
|
||||
contains
|
||||
procedure, pass(ag) :: bld_tprol => amg_s_hybrid_aggregator_build_tprol
|
||||
procedure, nopass :: fmt => amg_s_hybrid_aggregator_fmt
|
||||
end type amg_s_hybrid_aggregator_type
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_s_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
import :: amg_s_hybrid_aggregator_type, psb_desc_type, psb_sspmat_type, psb_spk_, &
|
||||
& psb_ipk_, psb_long_int_k_, amg_sml_parms
|
||||
implicit none
|
||||
class(amg_s_hybrid_aggregator_type), target, intent(inout) :: ag
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
|
||||
type(psb_sspmat_type), intent(out) :: op_prol
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_hybrid_aggregator_build_tprol
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
|
||||
function amg_s_hybrid_aggregator_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Hybrid Decoupled aggregation"
|
||||
end function amg_s_hybrid_aggregator_fmt
|
||||
|
||||
|
||||
end module amg_s_hybrid_aggregator_mod
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -157,7 +157,7 @@ contains
|
||||
return
|
||||
end subroutine s_id_solver_free
|
||||
|
||||
subroutine s_id_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_id_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -165,14 +165,12 @@ contains
|
||||
class(amg_s_id_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_id_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -180,13 +178,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Identity local solver '
|
||||
write(iout_,*) ' Identity local solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -234,7 +234,7 @@ contains
|
||||
! Arguments
|
||||
class(amg_s_ilu_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%fact_type = amg_ilu_n_
|
||||
sv%fact_type = psb_ilu_n_
|
||||
sv%fill_in = 0
|
||||
sv%thresh = szero
|
||||
|
||||
@@ -255,13 +255,13 @@ contains
|
||||
info = psb_success_
|
||||
|
||||
call amg_check_def(sv%fact_type,&
|
||||
& 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
|
||||
& 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
|
||||
|
||||
select case(sv%fact_type)
|
||||
case(amg_ilu_n_,amg_milu_n_)
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
call amg_check_def(sv%fill_in,&
|
||||
& 'Level',izero,is_int_non_negative)
|
||||
case(amg_ilu_t_)
|
||||
case(psb_ilu_t_)
|
||||
call amg_check_def(sv%thresh,&
|
||||
& 'Eps',szero,is_legal_s_fact_thrs)
|
||||
end select
|
||||
@@ -406,7 +406,7 @@ contains
|
||||
return
|
||||
end subroutine s_ilu_solver_free
|
||||
|
||||
subroutine s_ilu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_ilu_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -414,14 +414,12 @@ contains
|
||||
class(amg_s_ilu_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_ilu_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -430,20 +428,15 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
|
||||
write(iout_,*) ' Incomplete factorization solver: ',&
|
||||
& amg_fact_names(sv%fact_type)
|
||||
select case(sv%fact_type)
|
||||
case(amg_ilu_n_,amg_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
case(amg_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -496,7 +489,7 @@ contains
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_ilu_n_
|
||||
val = psb_ilu_n_
|
||||
end function s_ilu_solver_get_id
|
||||
|
||||
function s_ilu_solver_get_wrksize() result(val)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -39,7 +39,7 @@
|
||||
!
|
||||
! Module: amg_inner_mod
|
||||
!
|
||||
! This module defines the interfaces to inner AMG4PSBLAS routines.
|
||||
! This module defines the interfaces to inner MLD2P4 routines.
|
||||
! The interfaces of the user level routines are defined in amg_prec_mod.f90.
|
||||
!
|
||||
module amg_s_inner_mod
|
||||
@@ -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
|
||||
@@ -67,7 +67,7 @@ module amg_s_inner_mod
|
||||
end interface amg_mlprec_bld
|
||||
|
||||
interface amg_mlprec_aply
|
||||
subroutine amg_smlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
subroutine amg_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: amg_sprec_type
|
||||
implicit none
|
||||
@@ -79,7 +79,7 @@ module amg_s_inner_mod
|
||||
character,intent(in) :: trans
|
||||
real(psb_spk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_smlprec_aply_a
|
||||
end subroutine amg_smlprec_aply
|
||||
subroutine amg_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
import :: psb_sspmat_type, psb_desc_type, &
|
||||
& psb_spk_, psb_s_vect_type, psb_ipk_
|
||||
@@ -109,12 +109,11 @@ module amg_s_inner_mod
|
||||
end interface amg_map_to_tprol
|
||||
|
||||
abstract interface
|
||||
subroutine amg_saggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
subroutine amg_saggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_, psb_lsspmat_type
|
||||
import :: amg_s_onelev_type, amg_sml_parms
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
|
||||
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
@@ -20,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -52,9 +49,10 @@ module amg_s_invk_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_s_invk_solver_check
|
||||
procedure, pass(sv) :: clone => amg_s_invk_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_s_invk_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_s_invk_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_s_invk_solver_cseti
|
||||
procedure, pass(sv) :: seti => amg_s_invk_solver_seti
|
||||
generic, public :: set => seti
|
||||
procedure, pass(sv) :: descr => amg_s_invk_solver_descr
|
||||
procedure, pass(sv) :: default => s_invk_solver_default
|
||||
end type amg_s_invk_solver_type
|
||||
@@ -74,17 +72,6 @@ module amg_s_invk_solver
|
||||
end subroutine amg_s_invk_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invk_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& amg_s_base_solver_type, psb_spk_, amg_s_invk_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_s_invk_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_invk_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
@@ -94,7 +81,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
|
||||
@@ -135,7 +122,7 @@ module amg_s_invk_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invk_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_s_invk_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_spk_, amg_s_invk_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -145,10 +132,22 @@ module amg_s_invk_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_s_invk_solver_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invk_solver_seti(sv,what,val,info)
|
||||
import :: amg_s_invk_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_s_invk_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_invk_solver_seti
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine s_invk_solver_default(sv)
|
||||
|
||||
@@ -1,14 +1,11 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
@@ -20,7 +17,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -52,10 +49,12 @@ module amg_s_invt_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_s_invt_solver_check
|
||||
procedure, pass(sv) :: clone => amg_s_invt_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_s_invt_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_s_invt_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_s_invt_solver_cseti
|
||||
procedure, pass(sv) :: csetr => amg_s_invt_solver_csetr
|
||||
procedure, pass(sv) :: seti => amg_s_invt_solver_seti
|
||||
procedure, pass(sv) :: setr => amg_s_invt_solver_setr
|
||||
generic, public :: set => seti, setr
|
||||
procedure, pass(sv) :: descr => amg_s_invt_solver_descr
|
||||
procedure, pass(sv) :: default => s_invt_solver_default
|
||||
end type amg_s_invt_solver_type
|
||||
@@ -74,17 +73,6 @@ module amg_s_invt_solver
|
||||
end subroutine amg_s_invt_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invt_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& amg_s_base_solver_type, psb_spk_, amg_s_invt_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_s_invt_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_invt_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
@@ -94,7 +82,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
|
||||
@@ -146,21 +134,44 @@ module amg_s_invt_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invt_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_s_invt_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_spk_, amg_s_invt_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_invt_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
end subroutine amg_s_invt_solver_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invt_solver_setr(sv,what,val,info)
|
||||
import :: amg_s_invt_solver_type, psb_spk_, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_s_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_invt_solver_setr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invt_solver_seti(sv,what,val,info)
|
||||
import :: amg_s_invt_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_s_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine s_invt_solver_default(sv)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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
|
||||
@@ -203,8 +203,8 @@ module amg_s_jac_smoother
|
||||
subroutine amg_s_jac_smoother_clone_settings(sm,smout,info)
|
||||
import :: amg_s_jac_smoother_type, psb_spk_, &
|
||||
& amg_s_base_smoother_type, psb_ipk_
|
||||
class(amg_s_jac_smoother_type), intent(inout) :: sm
|
||||
class(amg_s_base_smoother_type), intent(inout) :: smout
|
||||
class(amg_s_jac_smoother_type), intent(inout) :: sm
|
||||
class(amg_s_base_smoother_type), allocatable, intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_jac_smoother_clone_settings
|
||||
end interface
|
||||
@@ -219,13 +219,12 @@ module amg_s_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_s_jac_smoother_type, psb_ipk_
|
||||
class(amg_s_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_s_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
@@ -274,7 +273,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
|
||||
@@ -314,13 +313,12 @@ module amg_s_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_s_l1_jac_smoother_type, psb_ipk_
|
||||
class(amg_s_l1_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_s_l1_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -1,585 +0,0 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific 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_s_jac_solver_mod.f90
|
||||
!
|
||||
! Module: amg_s_jac_solver_mod
|
||||
!
|
||||
! This module defines:
|
||||
! - the amg_s_jac_solver_type data structure containing the ingredients
|
||||
! for a local Jacobi iteration. The iterations are local to a process
|
||||
! (they operate on the block diagonal).
|
||||
!
|
||||
!
|
||||
module amg_s_jac_solver
|
||||
|
||||
use amg_s_base_solver_mod
|
||||
|
||||
type, extends(amg_s_base_solver_type) :: amg_s_jac_solver_type
|
||||
type(psb_sspmat_type) :: a
|
||||
type(psb_s_vect_type), allocatable :: dv
|
||||
real(psb_spk_), allocatable :: d(:)
|
||||
integer(psb_ipk_) :: sweeps
|
||||
real(psb_spk_) :: eps
|
||||
contains
|
||||
procedure, pass(sv) :: dump => amg_s_jac_solver_dmp
|
||||
procedure, pass(sv) :: check => s_jac_solver_check
|
||||
procedure, pass(sv) :: clone => amg_s_jac_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_s_jac_solver_clone_settings
|
||||
procedure, pass(sv) :: clear_data => amg_s_jac_solver_clear_data
|
||||
procedure, pass(sv) :: build => amg_s_jac_solver_bld
|
||||
procedure, pass(sv) :: cnv => amg_s_jac_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_s_jac_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_s_jac_solver_apply
|
||||
procedure, pass(sv) :: free => s_jac_solver_free
|
||||
procedure, pass(sv) :: cseti => s_jac_solver_cseti
|
||||
procedure, pass(sv) :: csetc => s_jac_solver_csetc
|
||||
procedure, pass(sv) :: csetr => s_jac_solver_csetr
|
||||
procedure, pass(sv) :: descr => s_jac_solver_descr
|
||||
procedure, pass(sv) :: default => s_jac_solver_default
|
||||
procedure, pass(sv) :: sizeof => s_jac_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => s_jac_solver_get_nzeros
|
||||
procedure, nopass :: get_wrksz => s_jac_solver_get_wrksize
|
||||
procedure, nopass :: get_fmt => s_jac_solver_get_fmt
|
||||
procedure, nopass :: get_id => s_jac_solver_get_id
|
||||
procedure, nopass :: is_iterative => s_jac_solver_is_iterative
|
||||
end type amg_s_jac_solver_type
|
||||
|
||||
type, extends(amg_s_jac_solver_type) :: amg_s_l1_jac_solver_type
|
||||
contains
|
||||
procedure, pass(sv) :: build => amg_s_l1_jac_solver_bld
|
||||
procedure, pass(sv) :: descr => s_l1_jac_solver_descr
|
||||
procedure, nopass :: get_fmt => s_l1_jac_solver_get_fmt
|
||||
procedure, nopass :: get_id => s_l1_jac_solver_get_id
|
||||
end type amg_s_l1_jac_solver_type
|
||||
|
||||
|
||||
private :: s_jac_solver_bld, s_jac_solver_apply, &
|
||||
& s_jac_solver_free, &
|
||||
& s_jac_solver_descr, s_jac_solver_sizeof, &
|
||||
& s_jac_solver_default, s_jac_solver_dmp, &
|
||||
& s_jac_solver_apply_vect, s_jac_solver_get_nzeros, &
|
||||
& s_jac_solver_get_fmt, s_jac_solver_check,&
|
||||
& s_jac_solver_is_iterative, &
|
||||
& s_jac_solver_get_id, s_jac_solver_get_wrksize
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
type(psb_s_vect_type),intent(inout) :: x
|
||||
type(psb_s_vect_type),intent(inout) :: y
|
||||
real(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_spk_),target, intent(inout) :: work(:)
|
||||
type(psb_s_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_s_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_s_jac_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
|
||||
import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
real(psb_spk_),intent(inout) :: x(:)
|
||||
real(psb_spk_),intent(inout) :: y(:)
|
||||
real(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_spk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_spk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_s_jac_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_sspmat_type), intent(in), target, optional :: b
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_s_jac_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_s_l1_jac_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_l1_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_sspmat_type), intent(in), target, optional :: b
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_s_l1_jac_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_cnv(sv,info,amold,vmold,imold)
|
||||
import :: amg_s_jac_solver_type, psb_spk_, &
|
||||
& psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_s_jac_solver_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
|
||||
& psb_ipk_
|
||||
implicit none
|
||||
class(amg_s_jac_solver_type), intent(in) :: sv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: solver, global_num
|
||||
end subroutine amg_s_jac_solver_dmp
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_clone(sv,svout,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_base_solver_type, amg_s_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_jac_solver_clone
|
||||
end interface
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine amg_s_l1_jac_solver_clone(sv,svout,info)
|
||||
!!$ import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
!!$ & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
!!$ & amg_s_base_solver_type, amg_s_l1_jac_solver_type, psb_ipk_
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_s_l1_jac_solver_type), intent(inout) :: sv
|
||||
!!$ class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_s_l1_jac_solver_clone
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_base_solver_type, amg_s_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_jac_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_clear_data(sv,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_jac_solver_clear_data
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine s_jac_solver_default(sv)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%sweeps = ione
|
||||
sv%eps = dzero
|
||||
|
||||
return
|
||||
end subroutine s_jac_solver_default
|
||||
|
||||
subroutine s_jac_solver_check(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_jac_solver_check'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
call amg_check_def(sv%sweeps,&
|
||||
& 'Jacobi sweeps',ione,is_int_positive)
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine s_jac_solver_check
|
||||
|
||||
subroutine s_jac_solver_cseti(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_jac_solver_cseti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SOLVER_SWEEPS')
|
||||
sv%sweeps = val
|
||||
case default
|
||||
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_jac_solver_cseti
|
||||
|
||||
subroutine s_jac_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='s_jac_solver_csetc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_jac_solver_csetc
|
||||
|
||||
subroutine s_jac_solver_csetr(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_jac_solver_csetr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SOLVER_EPS')
|
||||
sv%eps = val
|
||||
case default
|
||||
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
|
||||
end select
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_jac_solver_csetr
|
||||
|
||||
subroutine s_jac_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_jac_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
call sv%a%free()
|
||||
if (allocated(sv%dv)) then
|
||||
call sv%dv%free(info)
|
||||
deallocate(sv%dv)
|
||||
end if
|
||||
if (allocated(sv%d)) deallocate(sv%d)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_jac_solver_free
|
||||
|
||||
subroutine s_jac_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_jac_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
iout_ = iout
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_jac_solver_descr
|
||||
|
||||
function s_jac_solver_get_nzeros(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = 0
|
||||
val = val + sv%a%get_nzeros()
|
||||
val = val + sv%dv%get_nrows()
|
||||
|
||||
return
|
||||
end function s_jac_solver_get_nzeros
|
||||
|
||||
function s_jac_solver_sizeof(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = psb_sizeof_ip
|
||||
val = val + sv%a%sizeof()
|
||||
val = val + sv%dv%sizeof()
|
||||
|
||||
return
|
||||
end function s_jac_solver_sizeof
|
||||
|
||||
function s_jac_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Jacobi solver"
|
||||
end function s_jac_solver_get_fmt
|
||||
|
||||
function s_jac_solver_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_jac_
|
||||
end function s_jac_solver_get_id
|
||||
|
||||
!
|
||||
! If this is true, then the solver needs a starting
|
||||
! guess. Currently only handled in JAC smoother.
|
||||
!
|
||||
function s_jac_solver_is_iterative() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function s_jac_solver_is_iterative
|
||||
|
||||
function s_jac_solver_get_wrksize() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = 2
|
||||
end function s_jac_solver_get_wrksize
|
||||
|
||||
subroutine s_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_l1_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_l1_jac_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
iout_ = iout
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_l1_jac_solver_descr
|
||||
|
||||
function s_l1_jac_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "L1-Jacobi solver"
|
||||
end function s_l1_jac_solver_get_fmt
|
||||
|
||||
function s_l1_jac_solver_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_l1_jac_
|
||||
end function s_l1_jac_solver_get_id
|
||||
|
||||
end module amg_s_jac_solver
|
||||
File diff suppressed because it is too large
Load Diff
@@ -3,9 +3,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -21,7 +21,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -52,10 +52,10 @@
|
||||
!
|
||||
module amg_s_mumps_solver
|
||||
use amg_s_base_solver_mod
|
||||
#if defined(AMG_HAVE_MUMPS) && defined(AMG_HAVE_MUMPS_MODULES)
|
||||
#if defined(HAVE_MUMPS_) && defined(HAVE_MUMPS_MODULES_)
|
||||
use smumps_struc_def
|
||||
#endif
|
||||
#if defined(AMG_HAVE_MUMPS) && defined(AMG_HAVE_MUMPS_INCLUDES)
|
||||
#if defined(HAVE_MUMPS_) && defined(HAVE_MUMPS_INCLUDES_)
|
||||
include 'smumps_struc.h'
|
||||
#endif
|
||||
|
||||
@@ -68,7 +68,7 @@ module amg_s_mumps_solver
|
||||
end type amg_s_mumps_rcntl_item
|
||||
|
||||
type, extends(amg_s_base_solver_type) :: amg_s_mumps_solver_type
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
type(smumps_struc), allocatable :: id
|
||||
#else
|
||||
integer, allocatable :: id
|
||||
@@ -78,8 +78,7 @@ module amg_s_mumps_solver
|
||||
!
|
||||
! Controls to be set before MUMPS instantiation:
|
||||
!
|
||||
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: 'LOCAL_SOLVER
|
||||
! 1==amg_global_solver_: 'GLOBAL_SOLVER'
|
||||
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: LOCAL 1==amg_global_solver_: GLOBAL
|
||||
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
|
||||
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
|
||||
integer(psb_ipk_), dimension(3) :: ipar
|
||||
@@ -163,7 +162,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
|
||||
@@ -189,7 +188,7 @@ contains
|
||||
|
||||
info = 0
|
||||
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -239,7 +238,7 @@ contains
|
||||
character(len=20) :: name='s_mumps_solver_clear_data'
|
||||
|
||||
info = 0
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
call psb_erractionsave(err_act)
|
||||
if (allocated(sv%id)) then
|
||||
if (sv%built) then
|
||||
@@ -279,7 +278,7 @@ contains
|
||||
character(len=20) :: name='s_mumps_solver_free'
|
||||
|
||||
info = 0
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
call psb_erractionsave(err_act)
|
||||
call sv%clear_data(info)
|
||||
if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
|
||||
@@ -314,24 +313,22 @@ subroutine s_mumps_solver_finalize(sv)
|
||||
|
||||
end subroutine s_mumps_solver_finalize
|
||||
|
||||
subroutine s_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_mumps_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_mumps_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: me, np
|
||||
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -340,13 +337,8 @@ subroutine s_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
|
||||
write(iout_,*) ' MUMPS Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
@@ -383,7 +375,7 @@ subroutine s_mumps_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
case('MUMPS_LOC_GLOB')
|
||||
sv%ipar(1) = sv%stringval(psb_toupper(trim(val)))
|
||||
#endif
|
||||
@@ -421,7 +413,7 @@ subroutine s_mumps_solver_cseti(sv,what,val,info,idx)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(what))
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
case('MUMPS_LOC_GLOB')
|
||||
sv%ipar(1) = val
|
||||
case('MUMPS_PRINT_ERR')
|
||||
@@ -467,7 +459,7 @@ subroutine s_mumps_solver_csetr(sv,what,val,info,idx)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(what))
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
case('MUMPS_RPAR_ENTRY')
|
||||
if(present(idx)) then
|
||||
! Note: this will allocate %item
|
||||
@@ -504,7 +496,7 @@ subroutine s_mumps_solver_default(sv)
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
if (.not.allocated(sv%id)) then
|
||||
allocate(sv%id,stat=info)
|
||||
if (info /= psb_success_) then
|
||||
@@ -561,7 +553,7 @@ function s_mumps_solver_sizeof(sv) result(val)
|
||||
class(amg_s_mumps_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer :: i
|
||||
#if defined(AMG_HAVE_MUMPS)
|
||||
#if defined(HAVE_MUMPS_)
|
||||
val = (sv%id%INFOG(22)+sv%id%INFOG(32))*1d+6
|
||||
#else
|
||||
val = 0
|
||||
|
||||
+392
-349
File diff suppressed because it is too large
Load Diff
@@ -1,684 +0,0 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific 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.
|
||||
!
|
||||
! moved here from amg4psblas-extension
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS Extensions
|
||||
!
|
||||
! (C) Copyright 2019
|
||||
!
|
||||
! Salvatore Filippone Cranfield University
|
||||
! Pasqua D'Ambra IAC-CNR, Naples, IT
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific 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.
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! The aggregator object hosts the aggregation method for building
|
||||
! the multilevel hierarchy. This variant is based on the hybrid method
|
||||
! presented in
|
||||
!
|
||||
!
|
||||
! sm - class(amg_T_base_smoother_type), allocatable
|
||||
! The current level preconditioner (aka smoother).
|
||||
! parms - type(amg_RTml_parms)
|
||||
! The parameters defining the multilevel strategy.
|
||||
! ac - The local part of the current-level matrix, built by
|
||||
! coarsening the previous-level matrix.
|
||||
! desc_ac - type(psb_desc_type).
|
||||
! The communication descriptor associated to the matrix
|
||||
! stored in ac.
|
||||
! base_a - type(psb_Tspmat_type), pointer.
|
||||
! Pointer (really a pointer!) to the local part of the current
|
||||
! matrix (so we have a unified treatment of residuals).
|
||||
! We need this to avoid passing explicitly the current matrix
|
||||
! to the routine which applies the preconditioner.
|
||||
! base_desc - type(psb_desc_type), pointer.
|
||||
! Pointer to the communication descriptor associated to the
|
||||
! matrix pointed by base_a.
|
||||
! map - Stores the maps (restriction and prolongation) between the
|
||||
! vector spaces associated to the index spaces of the previous
|
||||
! and current levels.
|
||||
!
|
||||
! Methods:
|
||||
! Most methods follow the encapsulation hierarchy: they take whatever action
|
||||
! is appropriate for the current object, then call the corresponding method for
|
||||
! the contained object.
|
||||
! As an example: the descr() method prints out a description of the
|
||||
! level. It starts by invoking the descr() method of the parms object,
|
||||
! then calls the descr() method of the smoother object.
|
||||
!
|
||||
! descr - Prints a description of the object.
|
||||
! default - Set default values
|
||||
! dump - Dump to file object contents
|
||||
! set - Sets various parameters; when a request is unknown
|
||||
! it is passed to the smoother object for further processing.
|
||||
! check - Sanity checks.
|
||||
! sizeof - Total memory occupation in bytes
|
||||
! get_nzeros - Number of nonzeros
|
||||
!
|
||||
!
|
||||
|
||||
module amg_s_parmatch_aggregator_mod
|
||||
use amg_s_base_aggregator_mod
|
||||
use amg_s_matchboxp_mod
|
||||
type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
|
||||
integer(psb_ipk_) :: matching_alg
|
||||
integer(psb_ipk_) :: n_sweeps ! When n_sweeps >1 we need an auxiliary descriptor
|
||||
integer(psb_ipk_) :: orig_aggr_size
|
||||
integer(psb_ipk_) :: jacobi_sweeps
|
||||
real(psb_spk_), allocatable :: w(:), w_nxt(:)
|
||||
type(psb_sspmat_type), allocatable :: prol, restr
|
||||
type(psb_sspmat_type), allocatable :: ac, base_a, rwa
|
||||
type(psb_desc_type), allocatable :: desc_ac, desc_ax, base_desc, rwdesc
|
||||
logical :: reproducible_matching = .false.
|
||||
logical :: need_symmetrize = .false.
|
||||
logical :: unsmoothed_hierarchy = .true.
|
||||
contains
|
||||
procedure, pass(ag) :: bld_tprol => amg_s_parmatch_aggregator_build_tprol
|
||||
procedure, pass(ag) :: mat_bld => amg_s_parmatch_aggregator_mat_bld
|
||||
procedure, pass(ag) :: mat_asb => amg_s_parmatch_aggregator_mat_asb
|
||||
procedure, pass(ag) :: inner_mat_asb => amg_s_parmatch_aggregator_inner_mat_asb
|
||||
procedure, pass(ag) :: bld_linmap => amg_s_parmatch_aggregator_bld_linmap
|
||||
procedure, pass(ag) :: csetc => amg_s_parmatch_aggr_csetc
|
||||
procedure, pass(ag) :: cseti => amg_s_parmatch_aggr_cseti
|
||||
procedure, pass(ag) :: default => amg_s_parmatch_aggr_set_default
|
||||
procedure, pass(ag) :: sizeof => amg_s_parmatch_aggregator_sizeof
|
||||
procedure, pass(ag) :: update_next => amg_s_parmatch_aggregator_update_next
|
||||
procedure, pass(ag) :: bld_wnxt => amg_s_parmatch_bld_wnxt
|
||||
procedure, pass(ag) :: bld_default_w => amg_s_bld_default_w
|
||||
procedure, pass(ag) :: set_c_default_w => amg_s_set_prm_c_default_w
|
||||
procedure, pass(ag) :: descr => amg_s_parmatch_aggregator_descr
|
||||
procedure, pass(ag) :: clone => amg_s_parmatch_aggregator_clone
|
||||
procedure, pass(ag) :: free => amg_s_parmatch_aggregator_free
|
||||
procedure, nopass :: fmt => amg_s_parmatch_aggregator_fmt
|
||||
procedure, nopass :: xt_desc => amg_s_parmatch_aggregator_xt_desc
|
||||
end type amg_s_parmatch_aggregator_type
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
& a,desc_a,ilaggr,nlaggr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(amg_saggr_data), intent(in) :: ag_data
|
||||
type(psb_sspmat_type), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
|
||||
type(psb_lsspmat_type), intent(out) :: t_prol
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_aggregator_build_tprol
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(psb_lsspmat_type), intent(inout) :: t_prol
|
||||
type(psb_sspmat_type), intent(out) :: op_prol,ac,op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_aggregator_mat_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
|
||||
& ac,desc_ac, op_prol,op_restr,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol,ac,op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_aggregator_mat_asb
|
||||
end interface
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
|
||||
& ac,desc_ac, op_prol,op_restr,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol,op_restr
|
||||
type(psb_sspmat_type), intent(inout) :: ac
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_aggregator_inner_mat_asb
|
||||
end interface
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_lsspmat_type), intent(inout) :: t_prol
|
||||
type(psb_sspmat_type), intent(inout) :: ac, op_prol, op_restr
|
||||
type(psb_desc_type), intent(out) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_spmm_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_lsspmat_type), intent(inout) :: t_prol
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_unsmth_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_lsspmat_type), intent(inout) :: t_prol
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_smth_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_lsspmat_type), intent(inout) :: t_prol
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(out) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_spmm_bld_ov
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_spmm_bld_inner(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data,&
|
||||
& psb_s_csr_sparse_mat, psb_ls_csr_sparse_mat
|
||||
implicit none
|
||||
type(psb_s_csr_sparse_mat), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_lsspmat_type), intent(inout) :: t_prol
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(out) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_spmm_bld_inner
|
||||
end interface
|
||||
|
||||
private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels
|
||||
|
||||
contains
|
||||
|
||||
subroutine amg_s_bld_default_w(ag,nr)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
integer(psb_ipk_), intent(in) :: nr
|
||||
integer(psb_ipk_) :: info
|
||||
call psb_realloc(nr,ag%w,info)
|
||||
if (info /= psb_success_) return
|
||||
ag%w = done
|
||||
!call ag%set_c_default_w()
|
||||
end subroutine amg_s_bld_default_w
|
||||
|
||||
subroutine amg_s_set_prm_c_default_w(ag)
|
||||
use psb_realloc_mod
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
!write(0,*) 'prm_c_deafult_w '
|
||||
call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
|
||||
|
||||
end subroutine amg_s_set_prm_c_default_w
|
||||
|
||||
subroutine amg_s_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
integer(psb_lpk_), intent(in) :: ilaggr(:)
|
||||
real(psb_spk_), intent(in) :: valaggr(:)
|
||||
integer(psb_ipk_), intent(in) :: nx
|
||||
|
||||
integer(psb_ipk_) :: info,i,j
|
||||
|
||||
! The vector was already fixed in the call to BCMatch.
|
||||
!write(0,*) 'Executing bld_wnxt ',nx
|
||||
call psb_realloc(nx,ag%w_nxt,info)
|
||||
|
||||
end subroutine amg_s_parmatch_bld_wnxt
|
||||
|
||||
function amg_s_parmatch_aggregator_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Parallel Matching aggregation"
|
||||
end function amg_s_parmatch_aggregator_fmt
|
||||
|
||||
function amg_s_parmatch_aggregator_xt_desc() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function amg_s_parmatch_aggregator_xt_desc
|
||||
|
||||
function amg_s_parmatch_aggregator_sizeof(ag) result(val)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), intent(in) :: ag
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = 4
|
||||
val = val + psb_size(ag%w) + psb_size(ag%w_nxt)
|
||||
if (allocated(ag%ac)) val = val + ag%ac%sizeof()
|
||||
if (allocated(ag%base_a)) val = val + ag%base_a%sizeof()
|
||||
if (allocated(ag%prol)) val = val + ag%prol%sizeof()
|
||||
if (allocated(ag%restr)) val = val + ag%restr%sizeof()
|
||||
if (allocated(ag%desc_ac)) val = val + ag%desc_ac%sizeof()
|
||||
if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
|
||||
if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
|
||||
|
||||
end function amg_s_parmatch_aggregator_sizeof
|
||||
|
||||
subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
info = psb_success_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
|
||||
write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps
|
||||
write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_s_parmatch_aggregator_descr
|
||||
|
||||
function is_legal_malg(alg) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: alg
|
||||
|
||||
val = (0==alg)
|
||||
end function is_legal_malg
|
||||
|
||||
function is_legal_csize(csize) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: csize
|
||||
|
||||
val = ((-1==csize).or.(csize >0))
|
||||
end function is_legal_csize
|
||||
|
||||
function is_legal_nsweeps(nsw) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: nsw
|
||||
|
||||
val = (1<=nsw)
|
||||
end function is_legal_nsweeps
|
||||
|
||||
function is_legal_nlevels(nlv) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: nlv
|
||||
|
||||
val = (1<=nlv)
|
||||
end function is_legal_nlevels
|
||||
|
||||
|
||||
subroutine amg_s_parmatch_aggregator_update_next(ag,agnext,info)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
class(amg_s_base_aggregator_type), target, intent(inout) :: agnext
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
!
|
||||
select type(agnext)
|
||||
class is (amg_s_parmatch_aggregator_type)
|
||||
if (.not.is_legal_malg(agnext%matching_alg)) &
|
||||
& agnext%matching_alg = ag%matching_alg
|
||||
if (.not.is_legal_nsweeps(agnext%n_sweeps))&
|
||||
& agnext%n_sweeps = ag%n_sweeps
|
||||
!!$ if (.not.is_legal_csize(agnext%max_csize))&
|
||||
!!$ & agnext%max_csize = ag%max_csize
|
||||
!!$ if (.not.is_legal_nlevels(agnext%max_nlevels))&
|
||||
!!$ & agnext%max_nlevels = ag%max_nlevels
|
||||
! Is this going to generate shallow copies/memory leaks/double frees?
|
||||
! To be investigated further.
|
||||
call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
|
||||
call agnext%set_c_default_w()
|
||||
if (ag%unsmoothed_hierarchy) then
|
||||
agnext%unsmoothed_hierarchy = .true.
|
||||
call move_alloc(ag%rwdesc,agnext%base_desc)
|
||||
call move_alloc(ag%rwa,agnext%base_a)
|
||||
end if
|
||||
|
||||
class default
|
||||
! What should we do here?
|
||||
end select
|
||||
info = 0
|
||||
end subroutine amg_s_parmatch_aggregator_update_next
|
||||
|
||||
subroutine amg_s_parmatch_aggr_csetc(ag,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, iwhat
|
||||
character(len=20) :: name='s_parmatch_aggr_cseti'
|
||||
info = psb_success_
|
||||
|
||||
! For now we ignore IDX
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('PRMC_REPRODUCIBLE_MATCHING')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('F','FALSE')
|
||||
ag%reproducible_matching = .false.
|
||||
case('REPRODUCIBLE','TRUE','T')
|
||||
ag%reproducible_matching =.true.
|
||||
end select
|
||||
case('PRMC_NEED_SYMMETRIZE')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('FALSE','F')
|
||||
ag%need_symmetrize = .false.
|
||||
case('SYMMETRIZE','TRUE','T')
|
||||
ag%need_symmetrize =.true.
|
||||
end select
|
||||
case('PRMC_UNSMOOTHED_HIERARCHY')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('F','FALSE')
|
||||
ag%unsmoothed_hierarchy = .false.
|
||||
case('T','TRUE')
|
||||
ag%unsmoothed_hierarchy =.true.
|
||||
end select
|
||||
case default
|
||||
! Do nothing
|
||||
end select
|
||||
return
|
||||
end subroutine amg_s_parmatch_aggr_csetc
|
||||
|
||||
subroutine amg_s_parmatch_aggr_cseti(ag,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, iwhat
|
||||
character(len=20) :: name='s_parmatch_aggr_cseti'
|
||||
info = psb_success_
|
||||
|
||||
! For now we ignore IDX
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('PRMC_MATCH_ALG')
|
||||
ag%matching_alg=val
|
||||
case('PRMC_SWEEPS')
|
||||
ag%n_sweeps=val
|
||||
case('AGGR_SIZE')
|
||||
ag%orig_aggr_size = val
|
||||
ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
|
||||
case('PRMC_W_SIZE')
|
||||
call ag%bld_default_w(val)
|
||||
case('PRMC_REPRODUCIBLE_MATCHING')
|
||||
ag%reproducible_matching = (val == 1)
|
||||
case('PRMC_NEED_SYMMETRIZE')
|
||||
ag%need_symmetrize = (val == 1)
|
||||
case('PRMC_UNSMOOTHED_HIERARCHY')
|
||||
ag%unsmoothed_hierarchy = (val == 1)
|
||||
case default
|
||||
! Do nothing
|
||||
end select
|
||||
return
|
||||
end subroutine amg_s_parmatch_aggr_cseti
|
||||
|
||||
subroutine amg_s_parmatch_aggr_set_default(ag)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
|
||||
character(len=20) :: name='s_parmatch_aggr_set_default'
|
||||
call ag%amg_s_base_aggregator_type%default()
|
||||
ag%matching_alg = 0
|
||||
ag%n_sweeps = 1
|
||||
ag%jacobi_sweeps = 0
|
||||
!!$ ag%max_nlevels = 36
|
||||
!!$ ag%max_csize = -1
|
||||
!
|
||||
! Apparently BootCMatch works better
|
||||
! by keeping all entries
|
||||
!
|
||||
ag%do_clean_zeros = .false.
|
||||
|
||||
return
|
||||
|
||||
end subroutine amg_s_parmatch_aggr_set_default
|
||||
|
||||
subroutine amg_s_parmatch_aggregator_free(ag,info)
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
if ((info == 0).and.allocated(ag%w)) deallocate(ag%w,stat=info)
|
||||
if ((info == 0).and.allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info)
|
||||
if ((info == 0).and.allocated(ag%prol)) then
|
||||
call ag%prol%free(); deallocate(ag%prol,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%restr)) then
|
||||
call ag%restr%free(); deallocate(ag%restr,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%ac)) then
|
||||
call ag%ac%free(); deallocate(ag%ac,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%base_a)) then
|
||||
call ag%base_a%free(); deallocate(ag%base_a,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%rwa)) then
|
||||
call ag%rwa%free(); deallocate(ag%rwa,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%desc_ac)) then
|
||||
call ag%desc_ac%free(info); deallocate(ag%desc_ac,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%desc_ax)) then
|
||||
call ag%desc_ax%free(info); deallocate(ag%desc_ax,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%base_desc)) then
|
||||
call ag%base_desc%free(info); deallocate(ag%base_desc,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%rwdesc)) then
|
||||
call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine amg_s_parmatch_aggregator_free
|
||||
|
||||
subroutine amg_s_parmatch_aggregator_clone(ag,agnext,info)
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
|
||||
class(amg_s_base_aggregator_type), allocatable, intent(inout) :: agnext
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(agnext)) then
|
||||
call agnext%free(info)
|
||||
if (info == 0) deallocate(agnext,stat=info)
|
||||
end if
|
||||
if (info /= 0) return
|
||||
allocate(agnext,source=ag,stat=info)
|
||||
select type(agnext)
|
||||
class is (amg_s_parmatch_aggregator_type)
|
||||
call agnext%set_c_default_w()
|
||||
class default
|
||||
! Should never ever get here
|
||||
info = -1
|
||||
end select
|
||||
end subroutine amg_s_parmatch_aggregator_clone
|
||||
|
||||
subroutine amg_s_parmatch_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(psb_desc_type), intent(in), target :: desc_a, desc_ac
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol, op_restr
|
||||
type(psb_slinmap_type), intent(out) :: map
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_parmatch_aggregator_bld_linmap'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
!
|
||||
! Copy the prolongation/restriction matrices into the descriptor map.
|
||||
! op_restr => PR^T i.e. restriction operator
|
||||
! op_prol => PR i.e. prolongation operator
|
||||
!
|
||||
! For parmatch have an explicit copy of the descriptors
|
||||
!
|
||||
if (allocated(ag%desc_ax)) then
|
||||
!!$ write(0,*) 'Building linmap with ag%desc_ax ',ag%desc_ax%get_local_rows(),ag%desc_ax%get_local_cols(),&
|
||||
!!$ & desc_ac%get_local_rows(),desc_ac%get_local_cols()
|
||||
map = psb_linmap(psb_map_gen_linear_,ag%desc_ax,&
|
||||
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
|
||||
else
|
||||
map = psb_linmap(psb_map_gen_linear_,desc_a,&
|
||||
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine amg_s_parmatch_aggregator_bld_linmap
|
||||
end module amg_s_parmatch_aggregator_mod
|
||||
@@ -1,374 +0,0 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Daniela di Serafino
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific 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_s_poly_smoother_mod.f90
|
||||
!
|
||||
! Module: amg_s_poly_smoother_mod
|
||||
!
|
||||
! This module defines:
|
||||
! the amg_s_poly_smoother_type data structure containing the
|
||||
! smoother for a Jacobi/block Jacobi smoother.
|
||||
! The smoother stores in ND the block off-diagonal matrix.
|
||||
! One special case is treated separately, when the solver is DIAG or L1-DIAG
|
||||
! then the ND is the entire off-diagonal part of the matrix (including the
|
||||
! main diagonal block), so that it becomes possible to implement
|
||||
! a pure Jacobi or L1-Jacobi global solver.
|
||||
!
|
||||
module amg_s_poly_smoother
|
||||
use amg_s_base_smoother_mod
|
||||
use amg_d_poly_coeff_mod
|
||||
|
||||
type, extends(amg_s_base_smoother_type) :: amg_s_poly_smoother_type
|
||||
! The local solver component is inherited from the
|
||||
! parent type.
|
||||
! class(amg_s_base_solver_type), allocatable :: sv
|
||||
!
|
||||
integer(psb_ipk_) :: pdegree, variant
|
||||
integer(psb_ipk_) :: rho_estimate=amg_poly_rho_est_power_
|
||||
integer(psb_ipk_) :: rho_estimate_iterations=10
|
||||
type(psb_sspmat_type), pointer :: pa => null()
|
||||
real(psb_spk_), allocatable :: poly_beta(:)
|
||||
real(psb_spk_) :: cf_a = szero
|
||||
real(psb_spk_) :: rho_ba = -sone
|
||||
contains
|
||||
procedure, pass(sm) :: apply_v => amg_s_poly_smoother_apply_vect
|
||||
!!$ procedure, pass(sm) :: apply_a => amg_s_poly_smoother_apply
|
||||
procedure, pass(sm) :: dump => amg_s_poly_smoother_dmp
|
||||
procedure, pass(sm) :: build => amg_s_poly_smoother_bld
|
||||
procedure, pass(sm) :: cnv => amg_s_poly_smoother_cnv
|
||||
procedure, pass(sm) :: clone => amg_s_poly_smoother_clone
|
||||
procedure, pass(sm) :: clone_settings => amg_s_poly_smoother_clone_settings
|
||||
procedure, pass(sm) :: clear_data => amg_s_poly_smoother_clear_data
|
||||
procedure, pass(sm) :: free => s_poly_smoother_free
|
||||
procedure, pass(sm) :: cseti => amg_s_poly_smoother_cseti
|
||||
procedure, pass(sm) :: csetc => amg_s_poly_smoother_csetc
|
||||
procedure, pass(sm) :: csetr => amg_s_poly_smoother_csetr
|
||||
procedure, pass(sm) :: descr => amg_s_poly_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => s_poly_smoother_sizeof
|
||||
procedure, pass(sm) :: default => s_poly_smoother_default
|
||||
procedure, pass(sm) :: get_nzeros => s_poly_smoother_get_nzeros
|
||||
procedure, pass(sm) :: get_wrksz => s_poly_smoother_get_wrksize
|
||||
procedure, nopass :: get_fmt => s_poly_smoother_get_fmt
|
||||
procedure, nopass :: get_id => s_poly_smoother_get_id
|
||||
end type amg_s_poly_smoother_type
|
||||
private :: s_poly_smoother_free, &
|
||||
& s_poly_smoother_sizeof, s_poly_smoother_get_nzeros, &
|
||||
& s_poly_smoother_get_fmt, s_poly_smoother_get_id, &
|
||||
& s_poly_smoother_get_wrksize
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
& sweeps,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_
|
||||
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
type(psb_s_vect_type),intent(inout) :: x
|
||||
type(psb_s_vect_type),intent(inout) :: y
|
||||
real(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
integer(psb_ipk_), intent(in) :: sweeps
|
||||
real(psb_spk_),target, intent(inout) :: work(:)
|
||||
type(psb_s_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_s_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_s_poly_smoother_apply_vect
|
||||
end interface
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine amg_s_poly_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
!!$ & sweeps,work,info,init,initu)
|
||||
!!$ import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
|
||||
!!$ & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
|
||||
!!$ & psb_ipk_
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
!!$ real(psb_spk_),intent(inout) :: x(:)
|
||||
!!$ real(psb_spk_),intent(inout) :: y(:)
|
||||
!!$ real(psb_spk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ integer(psb_ipk_), intent(in) :: sweeps
|
||||
!!$ real(psb_spk_),target, intent(inout) :: work(:)
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ real(psb_spk_),intent(inout), optional :: initu(:)
|
||||
!!$ end subroutine amg_s_poly_smoother_apply
|
||||
!!$ end interface
|
||||
!!$
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_s_poly_smoother_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_cnv(sm,info,amold,vmold,imold)
|
||||
import :: amg_s_poly_smoother_type, psb_spk_, &
|
||||
& psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_s_poly_smoother_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
|
||||
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
|
||||
& psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, &
|
||||
& psb_ipk_
|
||||
implicit none
|
||||
class(amg_s_poly_smoother_type), intent(in) :: sm
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: smoother, solver, global_num
|
||||
end subroutine amg_s_poly_smoother_dmp
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_clone(sm,smout,info)
|
||||
import :: amg_s_poly_smoother_type, psb_spk_, &
|
||||
& amg_s_base_smoother_type, psb_ipk_
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
class(amg_s_base_smoother_type), allocatable, intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_poly_smoother_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_clone_settings(sm,smout,info)
|
||||
import :: amg_s_poly_smoother_type, psb_spk_, &
|
||||
& amg_s_base_smoother_type, psb_ipk_
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
class(amg_s_base_smoother_type), intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_poly_smoother_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_clear_data(sm,info)
|
||||
import :: amg_s_poly_smoother_type, psb_spk_, &
|
||||
& amg_s_base_smoother_type, psb_ipk_
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_poly_smoother_clear_data
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: amg_s_poly_smoother_type, psb_ipk_
|
||||
class(amg_s_poly_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_s_poly_smoother_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_cseti(sm,what,val,info,idx)
|
||||
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
|
||||
& psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_s_poly_smoother_cseti
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_csetc(sm,what,val,info,idx)
|
||||
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
|
||||
& psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_s_poly_smoother_csetc
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_csetr(sm,what,val,info,idx)
|
||||
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
|
||||
& psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_s_poly_smoother_csetr
|
||||
end interface
|
||||
|
||||
|
||||
contains
|
||||
|
||||
|
||||
subroutine s_poly_smoother_free(sm,info)
|
||||
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_poly_smoother_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
|
||||
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%free(info)
|
||||
if (info == psb_success_) deallocate(sm%sv,stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
end if
|
||||
if (allocated(sm%poly_beta)) deallocate(sm%poly_beta)
|
||||
sm%pa => null()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_poly_smoother_free
|
||||
|
||||
function s_poly_smoother_sizeof(sm) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_s_poly_smoother_type), intent(in) :: sm
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = psb_sizeof_dp
|
||||
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
|
||||
if (allocated(sm%poly_beta)) val = val + psb_sizeof_dp * size(sm%poly_beta)
|
||||
|
||||
return
|
||||
end function s_poly_smoother_sizeof
|
||||
|
||||
subroutine s_poly_smoother_default(sm)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
|
||||
!
|
||||
! Default: BJAC with no residual check
|
||||
!
|
||||
sm%pdegree = 1
|
||||
sm%rho_ba = -sone
|
||||
sm%variant = amg_cheb_4_
|
||||
sm%rho_estimate = amg_poly_rho_est_power_
|
||||
sm%rho_estimate_iterations = 20
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%default()
|
||||
end if
|
||||
|
||||
return
|
||||
end subroutine s_poly_smoother_default
|
||||
|
||||
function s_poly_smoother_get_nzeros(sm) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_s_poly_smoother_type), intent(in) :: sm
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = 0
|
||||
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()
|
||||
|
||||
return
|
||||
end function s_poly_smoother_get_nzeros
|
||||
|
||||
function s_poly_smoother_get_wrksize(sm) result(val)
|
||||
implicit none
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = 4
|
||||
if (allocated(sm%sv)) val = val + sm%sv%get_wrksz()
|
||||
|
||||
end function s_poly_smoother_get_wrksize
|
||||
|
||||
function s_poly_smoother_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Polynomial smoother"
|
||||
end function s_poly_smoother_get_fmt
|
||||
|
||||
function s_poly_smoother_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_poly_
|
||||
end function s_poly_smoother_get_id
|
||||
|
||||
|
||||
end module amg_s_poly_smoother
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -20,7 +20,7 @@
|
||||
! 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.
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -40,7 +40,7 @@
|
||||
! Module: amg_s_prec_mod
|
||||
!
|
||||
! This module defines the user interfaces to the real/complex, single/double
|
||||
! precision versions of the user-level AMG4PSBLAS routines.
|
||||
! precision versions of the user-level MLD2P4 routines.
|
||||
!
|
||||
module amg_s_prec_mod
|
||||
|
||||
@@ -55,7 +55,12 @@ module amg_s_prec_mod
|
||||
use amg_s_ainv_solver
|
||||
use amg_s_invk_solver
|
||||
use amg_s_invt_solver
|
||||
use amg_s_krm_solver
|
||||
|
||||
interface amg_precset
|
||||
module procedure amg_s_iprecsetsm, amg_s_iprecsetsv, &
|
||||
& amg_s_cprecseti, amg_s_cprecsetc, amg_s_cprecsetr, &
|
||||
& amg_s_iprecsetag
|
||||
end interface amg_precset
|
||||
|
||||
interface amg_extprol_bld
|
||||
subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
|
||||
@@ -77,4 +82,61 @@ module amg_s_prec_mod
|
||||
end subroutine amg_s_extprol_bld
|
||||
end interface amg_extprol_bld
|
||||
|
||||
contains
|
||||
|
||||
subroutine amg_s_iprecsetsm(p,val,info,pos)
|
||||
type(amg_sprec_type), intent(inout) :: p
|
||||
class(amg_s_base_smoother_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(val,info,pos=pos)
|
||||
end subroutine amg_s_iprecsetsm
|
||||
|
||||
subroutine amg_s_iprecsetsv(p,val,info,pos)
|
||||
type(amg_sprec_type), intent(inout) :: p
|
||||
class(amg_s_base_solver_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
call p%set(val,info, pos=pos)
|
||||
end subroutine amg_s_iprecsetsv
|
||||
|
||||
subroutine amg_s_iprecsetag(p,val,info,pos)
|
||||
type(amg_sprec_type), intent(inout) :: p
|
||||
class(amg_s_base_aggregator_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
call p%set(val,info, pos=pos)
|
||||
end subroutine amg_s_iprecsetag
|
||||
|
||||
subroutine amg_s_cprecseti(p,what,val,info,pos)
|
||||
type(amg_sprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_s_cprecseti
|
||||
|
||||
subroutine amg_s_cprecsetr(p,what,val,info,pos)
|
||||
type(amg_sprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_s_cprecsetr
|
||||
|
||||
subroutine amg_s_cprecsetc(p,what,val,info,pos)
|
||||
type(amg_sprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_s_cprecsetc
|
||||
|
||||
end module amg_s_prec_mod
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user