Compare commits

..
3 Commits
1072 changed files with 33369 additions and 290283 deletions
-12
View File
@@ -1,12 +0,0 @@
$Format:%d%n%n$
# Fall back version, probably last release:
1.2.0
# 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$
-28
View File
@@ -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
View File
@@ -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
-549
View File
@@ -1,549 +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
#if(NOT DEFINED PSBLAS_INSTALL_DIR)
# message(FATAL_ERROR "Please specify the path to the psblas installation directory using -DPSBLAS_INSTALL_DIR=<path>")
#endif()
message(STATUS "psblas directory is ${PSBLAS_INSTALL_DIR};;")
message(STATUS "PSBLAS DIRECTORY INC ${INCDIR}; MOD ${MODDIR}; LIB ${LIBDIR};")
#set(CMAKE_CXX_STANDARD 17) # Set cxx standard for the c++ part of the library
# 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};")
+164
View File
@@ -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.
+8 -6
View File
@@ -1,12 +1,14 @@
AMG4PSBLAS version 1.2
AMG4PSBLAS version 1.0
Algebraic Multigrid Package
based on PSBLAS (Parallel Sparse BLAS version 3.9)
based on PSBLAS (Parallel Sparse BLAS version 3.7)
(C) Copyright 2025 Salvatore Filippone
(C) Copyright 2025 Pasqua D'Ambra
(C) Copyright 2025 Fabio Durastante
(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
@@ -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
+2 -3
View File
@@ -70,13 +70,12 @@ EXTRALIBS=@EXTRA_LIBS@
#
AMGCDEFINES=$(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS)
#$(PSBCDEFINES) $(MUMPSFLAGS)
AMGCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
CDEFINES=$(AMGCDEFINES)
AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
FDEFINES=$(AMGFDEFINES)
CXXDEFINES=@AMGCXXDEFINES@ $(PSBCXXDEFINES)
CXXDEFINES=@AMGCXXDEFINES@
@COMPILERULES@
+1 -1
View File
@@ -49,7 +49,7 @@ PSBLAS_INCLUDES=@PSBLAS_INCLUDES@
PSBLAS_LIBS=@PSBLAS_LIBS@
PSBBASEMODNAME=psb_base_mod
PSBPRECMODNAME=psb_prec_mod
PSBMETHDMODNAME=psb_linsolve_mod
PSBMETHDMODNAME=psb_krylov_mod
PSBUTILMODNAME=psb_util_mod
+15 -23
View File
@@ -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
#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: mods
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)
@@ -45,18 +40,15 @@ cleanlib:
(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 samples/simple/fileread; make clean)
(cd samples/simple/pdegen; make clean)
(cd samples/advanced/fileread; make clean)
(cd samples/advanced/pdegen; make clean)
check: all
make check -C samples/advanced/pdegen
clean: cleanlib
(cd amgprec && $(MAKE) veryclean)
(cd cbind && $(MAKE) veryclean)
clean:
(cd amgprec; make clean)
+35 -146
View File
@@ -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
View File
@@ -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
-907
View File
@@ -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()
+21 -25
View File
@@ -9,10 +9,9 @@ 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 \
@@ -21,9 +20,9 @@ DMODOBJS=amg_d_prec_type.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 \
@@ -34,7 +33,7 @@ ZMODOBJS=amg_z_prec_type.o amg_z_ilu_fact_mod.o \
amg_z_inner_mod.o amg_z_ilu_solver.o amg_z_diag_solver.o amg_z_jac_smoother.o amg_z_as_smoother.o \
amg_z_umf_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o amg_z_id_solver.o\
amg_z_base_solver_mod.o amg_z_base_smoother_mod.o amg_z_onelev_mod.o \
amg_z_gs_solver.o amg_z_mumps_solver.o amg_z_jac_solver.o \
amg_z_gs_solver.o amg_z_mumps_solver.o \
amg_z_base_aggregator_mod.o \
amg_z_dec_aggregator_mod.o amg_z_symdec_aggregator_mod.o \
amg_z_ainv_solver.o amg_z_base_ainv_mod.o \
@@ -44,7 +43,7 @@ CMODOBJS=amg_c_prec_type.o amg_c_ilu_fact_mod.o \
amg_c_inner_mod.o amg_c_ilu_solver.o amg_c_diag_solver.o amg_c_jac_smoother.o amg_c_as_smoother.o \
amg_c_slu_solver.o amg_c_id_solver.o\
amg_c_base_solver_mod.o amg_c_base_smoother_mod.o amg_c_onelev_mod.o \
amg_c_gs_solver.o amg_c_mumps_solver.o amg_c_jac_solver.o \
amg_c_gs_solver.o amg_c_mumps_solver.o \
amg_c_base_aggregator_mod.o \
amg_c_dec_aggregator_mod.o amg_c_symdec_aggregator_mod.o \
amg_c_ainv_solver.o amg_c_base_ainv_mod.o \
@@ -58,28 +57,27 @@ MODOBJS=amg_base_prec_type.o amg_prec_type.o amg_prec_mod.o \
$(SMODOBJS) $(DMODOBJS) $(CMODOBJS) $(ZMODOBJS)
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: mods impld
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)
#amg_base_prec_type.o: amg_const.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
@@ -154,7 +152,7 @@ amg_z_base_ainv_mod.o: amg_z_base_solver_mod.o amg_base_ainv_mod.o
amg_s_base_solver_mod.o amg_d_base_solver_mod.o amg_c_base_solver_mod.o amg_z_base_solver_mod.o: amg_base_prec_type.o
amg_d_mumps_solver.o amg_d_gs_solver.o amg_d_id_solver.o amg_d_sludist_solver.o amg_d_slu_solver.o \
amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o amg_d_jac_solver.o: amg_d_base_solver_mod.o amg_d_prec_type.o
amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o: amg_d_base_solver_mod.o amg_d_prec_type.o
#amg_d_ilu_fact_mod.o: amg_base_prec_type.o amg_d_base_solver_mod.o
#amg_d_ilu_solver.o amg_d_iluk_fact.o: amg_d_ilu_fact_mod.o
@@ -163,11 +161,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
@@ -177,7 +173,7 @@ amg_sprecinit.o amg_sprecset.o: amg_s_diag_solver.o amg_s_ilu_solver.o \
amg_s_id_solver.o amg_s_slu_solver.o
amg_z_mumps_solver.o amg_z_gs_solver.o amg_z_id_solver.o amg_z_sludist_solver.o amg_z_slu_solver.o \
amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o amg_z_jac_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.o
amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.o
amg_z_ilu_fact_mod.o: amg_base_prec_type.o amg_z_base_solver_mod.o
amg_z_ilu_solver.o amg_z_iluk_fact.o: amg_z_ilu_fact_mod.o
amg_z_as_smoother.o amg_z_jac_smoother.o: amg_z_base_smoother_mod.o
@@ -187,7 +183,7 @@ amg_zprecinit.o amg_zprecset.o: amg_z_diag_solver.o amg_z_ilu_solver.o \
amg_z_id_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o
amg_c_mumps_solver.o amg_c_gs_solver.o amg_c_id_solver.o amg_c_sludist_solver.o amg_c_slu_solver.o \
amg_c_diag_solver.o amg_c_ilu_solver.o amg_c_jac_solver.o: amg_c_base_solver_mod.o amg_c_prec_type.o
amg_c_diag_solver.o amg_c_ilu_solver.o: amg_c_base_solver_mod.o amg_c_prec_type.o
amg_c_ilu_fact_mod.o: amg_base_prec_type.o amg_c_base_solver_mod.o
amg_c_ilu_solver.o amg_c_iluk_fact.o: amg_c_ilu_fact_mod.o
amg_c_as_smoother.o amg_c_jac_smoother.o: amg_c_base_smoother_mod.o
@@ -219,7 +215,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
+16
View File
@@ -0,0 +1,16 @@
#!/bin/bash
hn=amg_const.h
fn=amg_base_prec_type.F90
echo "/* This file was generated by a script using the $fn file as a basis. */" > $hn
echo '#ifndef AMG_CONST_H_' >> $hn
echo '#define AMG_CONST_H_' >> $hn
echo '#ifdef __cplusplus' >> $hn
echo 'extern "C" { ' >> $hn
echo '#endif' >> $hn
cat $fn | sed 's/=/= (/g;s/$/ )/g' | grep '\(^ *!\)\|parameter' | grep '_\>' | sed 's/^\s*//g;s/^.*:://g;s/\s*=\s*/ /g' | sed 's/,/\n/g;s/^ //g' | tr '[:lower:]' '[:upper:]' | grep ^AMG | sed 's/^/#define /g' >> $hn
echo '#ifdef __cplusplus' >> $hn
echo '}' >> $hn
echo '#endif' >> $hn
echo '#endif' >> $hn
exit
+1 -1
View File
@@ -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
+5 -1
View File
@@ -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
+86 -203
View File
@@ -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
@@ -64,7 +64,7 @@ module amg_base_prec_type
!
use psb_const_mod
use psb_base_mod, only :&
& psb_desc_type, psb_ctxt_type,&
& psb_desc_type, psb_i_vect_type, psb_i_base_vect_type,&
& psb_ipk_, psb_dpk_, psb_spk_, psb_epk_, &
& psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, &
& psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,&
@@ -81,10 +81,10 @@ module amg_base_prec_type
!
! Version numbers
!
character(len=*), parameter :: amg_version_string_ = "1.2.0"
character(len=*), parameter :: amg_version_string_ = "1.0.1"
integer(psb_ipk_), parameter :: amg_version_major_ = 1
integer(psb_ipk_), parameter :: amg_version_minor_ = 2
integer(psb_ipk_), parameter :: amg_patchlevel_ = 0
integer(psb_ipk_), parameter :: amg_version_minor_ = 0
integer(psb_ipk_), parameter :: amg_patchlevel_ = 1
type amg_ml_parms
integer(psb_ipk_) :: sweeps_pre, sweeps_post
@@ -94,7 +94,6 @@ module amg_base_prec_type
integer(psb_ipk_) :: aggr_omega_alg, aggr_eig, aggr_filter
integer(psb_ipk_) :: coarse_mat, coarse_solve
contains
procedure, pass(pm) :: get_coarse_mat => ml_parms_get_coarse_mat
procedure, pass(pm) :: get_coarse => ml_parms_get_coarse
procedure, pass(pm) :: clone => ml_parms_clone
procedure, pass(pm) :: descr => ml_parms_descr
@@ -215,8 +214,7 @@ module amg_base_prec_type
integer(psb_ipk_), parameter :: amg_fbgs_ = 6
integer(psb_ipk_), parameter :: amg_l1_gs_ = 7
integer(psb_ipk_), parameter :: amg_l1_fbgs_ = 8
integer(psb_ipk_), parameter :: amg_poly_ = 9
integer(psb_ipk_), parameter :: amg_max_prec_ = 9
integer(psb_ipk_), parameter :: amg_max_prec_ = 8
!
! Constants for pre/post signaling. Now only used internally
!
@@ -234,9 +232,9 @@ module amg_base_prec_type
integer(psb_ipk_), parameter :: amg_diag_scale_ = amg_slv_delta_+1
integer(psb_ipk_), parameter :: amg_l1_diag_scale_ = amg_slv_delta_+2
integer(psb_ipk_), parameter :: amg_gs_ = amg_slv_delta_+3
integer(psb_ipk_), parameter :: amg_ilu_n_ = amg_slv_delta_+4
integer(psb_ipk_), parameter :: amg_milu_n_ = amg_slv_delta_+5
integer(psb_ipk_), parameter :: amg_ilu_t_ = amg_slv_delta_+6
! !$ integer(psb_ipk_), parameter :: amg_ilu_n_ = amg_slv_delta_+4
! !$ integer(psb_ipk_), parameter :: amg_milu_n_ = amg_slv_delta_+5
! !$ integer(psb_ipk_), parameter :: amg_ilu_t_ = amg_slv_delta_+6
integer(psb_ipk_), parameter :: amg_slu_ = amg_slv_delta_+7
integer(psb_ipk_), parameter :: amg_umf_ = amg_slv_delta_+8
integer(psb_ipk_), parameter :: amg_sludist_ = amg_slv_delta_+9
@@ -288,19 +286,17 @@ module amg_base_prec_type
!
! Legal values for entry: amg_aggr_prol_
!
integer(psb_ipk_), parameter :: amg_no_smooth_ = 0
integer(psb_ipk_), parameter :: amg_smooth_prol_ = 1
integer(psb_ipk_), parameter :: amg_l1_smooth_prol_ = 2
integer(psb_ipk_), parameter :: amg_min_energy_ = 3
integer(psb_ipk_), parameter :: amg_no_smooth_ = 0
integer(psb_ipk_), parameter :: amg_smooth_prol_ = 1
integer(psb_ipk_), parameter :: amg_min_energy_ = 2
! Disabling min_energy for the time being.
integer(psb_ipk_), parameter :: amg_max_aggr_prol_= amg_l1_smooth_prol_
integer(psb_ipk_), parameter :: amg_max_aggr_prol_=amg_smooth_prol_
!
! Legal values for entry: amg_aggr_filter_
!
integer(psb_ipk_), parameter :: amg_no_filter_mat_ = 0
integer(psb_ipk_), parameter :: amg_filter_mat_ = 1
integer(psb_ipk_), parameter :: amg_filter_prow_mat_ = 2
integer(psb_ipk_), parameter :: amg_max_filter_mat_ = amg_filter_prow_mat_
integer(psb_ipk_), parameter :: amg_no_filter_mat_ = 0
integer(psb_ipk_), parameter :: amg_filter_mat_ = 1
integer(psb_ipk_), parameter :: amg_max_filter_mat_ = amg_filter_mat_
!
! Legal values for entry: amg_aggr_ord_
!
@@ -322,16 +318,6 @@ module amg_base_prec_type
integer(psb_ipk_), parameter :: amg_distr_mat_ = 0
integer(psb_ipk_), parameter :: amg_repl_mat_ = 1
integer(psb_ipk_), parameter :: amg_max_coarse_mat_ = amg_repl_mat_
!
! Legal values for entry: amg_poly_variant_
!
integer(psb_ipk_), parameter :: amg_cheb_4_ = 0
integer(psb_ipk_), parameter :: amg_cheb_4_opt_ = 1
integer(psb_ipk_), parameter :: amg_cheb_1_opt_ = 2
integer(psb_ipk_), parameter :: amg_poly_dbg_ = 8
integer(psb_ipk_), parameter :: amg_poly_rho_est_power_ = 0
!
! Legal values for entry: amg_prec_status_
!
@@ -378,11 +364,10 @@ module amg_base_prec_type
character(len=19), parameter, private :: &
& eigen_estimates(0:0)=(/'infinity norm '/)
character(len=15), parameter, private :: &
& aggr_prols(0:4)=(/'unsmoothed ','smoothed ',&
& 'l1-smoothed ','min energy ','bizr. smoothed'/)
& aggr_prols(0:3)=(/'unsmoothed ','smoothed ',&
& 'min energy ','bizr. smoothed'/)
character(len=15), parameter, private :: &
& aggr_filters(0:2)=(/'no filtering ','filtering ',&
& 'filtering rsum'/)
& aggr_filters(0:1)=(/'no filtering ','filtering '/)
character(len=15), parameter, private :: &
& matrix_names(0:1)=(/'distributed ','replicated '/)
character(len=18), parameter, private :: &
@@ -404,12 +389,12 @@ module amg_base_prec_type
& ml_names(0:7)=(/'none ','additive ',&
& 'multiplicative', 'VCycle ','WCycle ',&
& 'KCycle ','KCycleSym ','new ML '/)
character(len=16), parameter :: &
character(len=15), parameter :: &
& amg_fact_names(0:amg_max_sub_solve_)=(/&
& 'none ','Jacobi ',&
& 'L1-Jacobi ','none ','none ',&
& 'none ','none ','L1-GS ',&
& 'L1-FBGS ','Polynomial ','none ','Point Jacobi ',&
& 'L1-FBGS ','none ','Point Jacobi ',&
& 'L1-Jacobi ','Gauss-Seidel ','ILU(n) ',&
& 'MILU(n) ','ILU(t,n) ',&
& 'SuperLU ','UMFPACK LU ',&
@@ -471,12 +456,12 @@ contains
character(len=*), parameter :: name='amg_stringval'
! Local variable
integer :: index_tab
character(len=128) ::string2
character(len=15) ::string2
index_tab=index(string,char(9))
if (index_tab.NE.0) then
string2=string(1:index_tab-1)
string2=string(1:index_tab-1)
else
string2=string
string2=string
endif
select case(psb_toupper(trim(string2)))
case('NONE')
@@ -496,11 +481,11 @@ contains
case('BGS','BWGS')
val = amg_bwgs_
case('ILU')
val = amg_ilu_n_
val = psb_ilu_n_
case('MILU')
val = amg_milu_n_
val = psb_milu_n_
case('ILUT')
val = amg_ilu_t_
val = psb_ilu_t_
case('MUMPS')
val = amg_mumps_
case('UMF')
@@ -551,8 +536,6 @@ contains
val = amg_no_smooth_
case('SMOOTHED')
val = amg_smooth_prol_
case('L1-SMOOTHED','L1SMOOTHED')
val = amg_l1_smooth_prol_
case('MINENERGY')
val = amg_min_energy_
case('NOPREC')
@@ -573,18 +556,6 @@ contains
val = amg_krm_
case('AS')
val = amg_as_
case('POLY')
val = amg_poly_
case('CHEB_4')
val = amg_cheb_4_
case('CHEB_4_OPT')
val = amg_cheb_4_opt_
case('CHEB_1_OPT')
val = amg_cheb_1_opt_
case('POLY_DBG')
val = amg_poly_dbg_
case('POLY_RHO_EST_POWER')
val = amg_poly_rho_est_power_
case('A_NORMI')
val = amg_max_norm_
case('USER_CHOICE')
@@ -593,8 +564,6 @@ contains
val = amg_eig_est_
case('FILTER')
val = amg_filter_mat_
case('FILTERROWSUM')
val = amg_filter_prow_mat_
case('NOFILTER','NO_FILTER')
val = amg_no_filter_mat_
case('OUTER_SWEEPS')
@@ -608,37 +577,6 @@ contains
end select
end function amg_stringval
function amg_get_coarse_mat_name(val) result(res)
character(len=15) :: res
integer :: val
select case(val)
case (0,1)
res = matrix_names(val)
case default
res = 'Unknown '
end select
end function amg_get_coarse_mat_name
subroutine amg_warn_coarse_mat(val,expected)
integer(psb_ipk_) :: val, expected
integer(psb_mpk_) :: mval, mexp
if (val /= expected) then
mval = val
mexp = expected
write(0,*) 'Warning: resetting COARSE_MAT on an existing hierarchy from ',&
& amg_get_coarse_mat_name(mval), &
& ' to ',amg_get_coarse_mat_name(mexp)
end if
end subroutine amg_warn_coarse_mat
function ml_parms_get_coarse_mat(pm) result(res)
implicit none
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_) :: res
res = pm%coarse_mat
end function ml_parms_get_coarse_mat
subroutine ml_parms_get_coarse(pm,pmin)
implicit none
class(amg_ml_parms), intent(inout) :: pm
@@ -701,62 +639,53 @@ contains
& ml_names(pm%ml_cycle)
select case (pm%ml_cycle)
case (amg_add_ml_)
write(iout,*) ' Number of smoother sweeps/degree : ',&
write(iout,*) ' Number of smoother sweeps : ',&
& pm%sweeps_pre
case (amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_, amg_kcycle_ml_, amg_kcyclesym_ml_)
write(iout,*) ' Number of smoother sweeps/degree : pre: ',&
write(iout,*) ' Number of smoother sweeps : pre: ',&
& pm%sweeps_pre ,' post: ', pm%sweeps_post
end select
end if
end subroutine ml_parms_mlcycledsc
subroutine ml_parms_mldescr(pm,iout,info,prefix)
subroutine ml_parms_mldescr(pm,iout,info)
Implicit None
! Arguments
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then
write(iout,*) trim(prefix),' Parallel aggregation algorithm: ',&
write(iout,*) ' Parallel aggregation algorithm: ',&
& par_aggr_alg_names(pm%par_aggr_alg)
if (pm%aggr_type>0) write(iout,*) trim(prefix),' Aggregation type: ',&
if (pm%aggr_type>0) write(iout,*) ' Aggregation type: ',&
& aggr_type_names(pm%aggr_type)
!if (pm%par_aggr_alg /= amg_ext_aggr_) then
if ( pm%aggr_ord /= amg_aggr_ord_nat_) &
& write(iout,*) trim(prefix),' with initial ordering: ',&
& write(iout,*) ' with initial ordering: ',&
& ord_names(pm%aggr_ord)
write(iout,*) trim(prefix),' Aggregation prolongator: ', &
write(iout,*) ' Aggregation prolongator: ', &
& aggr_prols(pm%aggr_prol)
if (pm%aggr_prol /= amg_no_smooth_) then
write(iout,*) trim(prefix),' with: ', aggr_filters(pm%aggr_filter)
write(iout,*) ' with: ', aggr_filters(pm%aggr_filter)
if (pm%aggr_omega_alg == amg_eig_est_) then
write(iout,*) trim(prefix),' Damping omega computation: spectral radius estimate'
write(iout,*) trim(prefix),' Spectral radius estimate: ', &
write(iout,*) ' Damping omega computation: spectral radius estimate'
write(iout,*) ' Spectral radius estimate: ', &
& eigen_estimates(pm%aggr_eig)
else if (pm%aggr_omega_alg == amg_user_choice_) then
write(iout,*) trim(prefix),' Damping omega computation: user defined value.'
write(iout,*) ' Damping omega computation: user defined value.'
else
write(iout,*) trim(prefix),' Damping omega computation: unknown value in iprcparm!!'
write(iout,*) ' Damping omega computation: unknown value in iprcparm!!'
end if
end if
!end if
else
write(iout,*) trim(prefix),' Multilevel type: Unkonwn value. Something is amiss....',&
write(iout,*) ' Multilevel type: Unkonwn value. Something is amiss....',&
& pm%ml_cycle
end if
@@ -764,16 +693,15 @@ contains
end subroutine ml_parms_mldescr
subroutine ml_parms_descr(pm,iout,info,coarse,prefix)
subroutine ml_parms_descr(pm,iout,info,coarse)
Implicit None
! Arguments
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
logical :: coarse_
info = psb_success_
@@ -784,7 +712,7 @@ contains
end if
if (coarse_) then
call pm%coarsedescr(iout,info,prefix=prefix)
call pm%coarsedescr(iout,info)
end if
return
@@ -792,126 +720,81 @@ contains
end subroutine ml_parms_descr
subroutine ml_parms_coarsedescr(pm,iout,info,prefix)
subroutine ml_parms_coarsedescr(pm,iout,info)
Implicit None
! Arguments
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
class(amg_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout,*) trim(prefix),' Coarse matrix: ',&
write(iout,*) ' Coarse matrix: ',&
& matrix_names(pm%coarse_mat)
select case(pm%coarse_solve)
case (amg_bjac_,amg_as_)
write(iout,*) trim(prefix),' Coarse solver: ',&
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_pre
write(iout,*) ' Coarse solver: ',&
& 'Block Jacobi'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_l1_bjac_)
write(iout,*) trim(prefix),' Coarse solver: ',&
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_pre
write(iout,*) ' Coarse solver: ',&
& 'L1-Block Jacobi'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_jac_)
write(iout,*) trim(prefix),' Coarse solver: ',&
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps_pre
write(iout,*) ' Coarse solver: ',&
& 'Point Jacobi'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_l1_jac_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'L1-Jacobi'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_l1_fbgs_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'L1 Forward-Backward Gauss-Seidel (Hybrid)'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_l1_gs_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'L1 Gauss-Seidel (Hybrid)'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case (amg_fbgs_)
write(iout,*) trim(prefix),' Coarse solver: ',&
& 'Forward-Backward Gauss-Seidel (Hybrid)'
write(iout,*) trim(prefix),' Number of sweeps : ',&
& pm%sweeps_pre
case default
write(iout,*) trim(prefix),' Coarse solver: ',&
write(iout,*) ' Coarse solver: ',&
& amg_fact_names(pm%coarse_solve)
end select
end subroutine ml_parms_coarsedescr
subroutine s_ml_parms_descr(pm,iout,info,coarse,prefix)
subroutine s_ml_parms_descr(pm,iout,info,coarse)
Implicit None
! Arguments
class(amg_sml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
class(amg_sml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
info = psb_success_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix)
call pm%amg_ml_parms%descr(iout,info,coarse)
if (pm%aggr_prol /= amg_no_smooth_) then
write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val
write(iout,*) ' Damping omega value :',pm%aggr_omega_val
end if
write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh
return
end subroutine s_ml_parms_descr
subroutine d_ml_parms_descr(pm,iout,info,coarse,prefix)
subroutine d_ml_parms_descr(pm,iout,info,coarse)
Implicit None
! Arguments
class(amg_dml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
class(amg_dml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
info = psb_success_
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix)
call pm%amg_ml_parms%descr(iout,info,coarse)
if (pm%aggr_prol /= amg_no_smooth_) then
write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val
write(iout,*) ' Damping omega value :',pm%aggr_omega_val
end if
write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh
return
@@ -1070,8 +953,8 @@ contains
integer(psb_ipk_), intent(in) :: ip
logical :: is_legal_ilu_fact
is_legal_ilu_fact = ((ip==amg_ilu_n_).or.&
& (ip==amg_milu_n_).or.(ip==amg_ilu_t_))
is_legal_ilu_fact = ((ip==psb_ilu_n_).or.&
& (ip==psb_milu_n_).or.(ip==psb_ilu_t_))
return
end function is_legal_ilu_fact
function is_legal_d_omega(ip)
@@ -1211,7 +1094,7 @@ contains
implicit none
type(psb_ctxt_type), intent(in) :: ctxt
type(amg_ml_parms), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: root
call psb_bcast(ctxt,dat%sweeps_pre,root)
call psb_bcast(ctxt,dat%sweeps_post,root)
@@ -1233,7 +1116,7 @@ contains
implicit none
type(psb_ctxt_type), intent(in) :: ctxt
type(amg_sml_parms), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: root
call psb_bcast(ctxt,dat%amg_ml_parms,root)
call psb_bcast(ctxt,dat%aggr_omega_val,root)
@@ -1244,7 +1127,7 @@ contains
implicit none
type(psb_ctxt_type), intent(in) :: ctxt
type(amg_dml_parms), intent(inout) :: dat
integer(psb_mpk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: root
call psb_bcast(ctxt,dat%amg_ml_parms,root)
call psb_bcast(ctxt,dat%aggr_omega_val,root)
+6 -14
View File
@@ -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
@@ -58,10 +58,12 @@ 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
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 +85,6 @@ module amg_c_ainv_solver
end subroutine amg_c_ainv_solver_clone
end interface
interface
subroutine amg_c_ainv_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& amg_c_base_solver_type, psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
Implicit None
class(amg_c_ainv_solver_type), intent(inout) :: sv
class(amg_c_base_solver_type), 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)
@@ -206,7 +198,7 @@ module amg_c_ainv_solver
!!$ end interface
interface
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
Implicit None
@@ -216,7 +208,7 @@ module amg_c_ainv_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_c_ainv_solver_descr
end interface
+10 -17
View File
@@ -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
@@ -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)
+5 -13
View File
@@ -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
@@ -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
@@ -486,7 +479,6 @@ contains
integer(psb_ipk_) :: err_act
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.
+1 -1
View File
@@ -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 -3
View File
@@ -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
@@ -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
+3 -3
View File
@@ -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
@@ -270,7 +270,7 @@ module amg_c_base_solver_mod
end interface
interface
subroutine amg_c_base_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_c_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_solver_type, psb_ipk_
@@ -281,7 +281,7 @@ module amg_c_base_solver_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_c_base_solver_descr
end interface
+6 -14
View File
@@ -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
+7 -21
View File
@@ -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
@@ -219,7 +219,7 @@ contains
end subroutine c_diag_solver_free
subroutine c_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine c_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -228,13 +228,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -242,13 +240,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Diagonal local solver '
write(iout_,*) ' Diagonal local solver '
return
@@ -359,7 +352,7 @@ module amg_c_l1_diag_solver
contains
subroutine c_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine c_l1_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -368,13 +361,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_l1_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -382,13 +373,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
write(iout_,*) ' L1 Diagonal solver '
return
+13 -27
View File
@@ -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
@@ -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
+125
View File
@@ -0,0 +1,125 @@
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! 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:
! 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
+4 -11
View File
@@ -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
@@ -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
+1 -1
View File
@@ -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
+15 -22
View File
@@ -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
@@ -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 -3
View File
@@ -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
@@ -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(:)
+3 -15
View File
@@ -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,6 @@ module amg_c_invk_solver
contains
procedure, pass(sv) :: check => amg_c_invk_solver_check
procedure, pass(sv) :: clone => amg_c_invk_solver_clone
procedure, pass(sv) :: clone_settings => amg_c_invk_solver_clone_settings
procedure, pass(sv) :: build => amg_c_invk_solver_bld
procedure, pass(sv) :: cseti => amg_c_invk_solver_cseti
procedure, pass(sv) :: descr => amg_c_invk_solver_descr
@@ -74,17 +73,6 @@ module amg_c_invk_solver
end subroutine amg_c_invk_solver_clone
end interface
interface
subroutine amg_c_invk_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& amg_c_base_solver_type, psb_spk_, amg_c_invk_solver_type, psb_ipk_
Implicit None
class(amg_c_invk_solver_type), intent(inout) :: sv
class(amg_c_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_invk_solver_clone_settings
end interface
interface
subroutine amg_c_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
@@ -135,7 +123,7 @@ module amg_c_invk_solver
end interface
interface
subroutine amg_c_invk_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_c_invk_solver_descr(sv,info,iout,coarse)
import :: psb_spk_, amg_c_invk_solver_type, psb_ipk_
Implicit None
@@ -145,7 +133,7 @@ module amg_c_invk_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_c_invk_solver_descr
end interface
+5 -18
View File
@@ -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,6 @@ module amg_c_invt_solver
contains
procedure, pass(sv) :: check => amg_c_invt_solver_check
procedure, pass(sv) :: clone => amg_c_invt_solver_clone
procedure, pass(sv) :: clone_settings => amg_c_invt_solver_clone_settings
procedure, pass(sv) :: build => amg_c_invt_solver_bld
procedure, pass(sv) :: cseti => amg_c_invt_solver_cseti
procedure, pass(sv) :: csetr => amg_c_invt_solver_csetr
@@ -74,17 +73,6 @@ module amg_c_invt_solver
end subroutine amg_c_invt_solver_clone
end interface
interface
subroutine amg_c_invt_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& amg_c_base_solver_type, psb_spk_, amg_c_invt_solver_type, psb_ipk_
Implicit None
class(amg_c_invt_solver_type), intent(inout) :: sv
class(amg_c_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_invt_solver_clone_settings
end interface
interface
subroutine amg_c_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
@@ -146,17 +134,16 @@ module amg_c_invt_solver
end interface
interface
subroutine amg_c_invt_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_c_invt_solver_descr(sv,info,iout,coarse)
import :: psb_spk_, amg_c_invt_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_c_invt_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine amg_c_invt_solver_descr
end interface
+10 -11
View File
@@ -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
@@ -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
@@ -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
@@ -345,6 +343,7 @@ contains
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)
-585
View File
@@ -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(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_c_jac_solver_bld
end interface
interface
subroutine amg_c_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_c_l1_jac_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_c_l1_jac_solver_bld
end interface
interface
subroutine amg_c_jac_solver_cnv(sv,info,amold,vmold,imold)
import :: amg_c_jac_solver_type, psb_spk_, &
& psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
class(amg_c_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_c_jac_solver_cnv
end interface
interface
subroutine amg_c_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, &
& psb_ipk_
implicit none
class(amg_c_jac_solver_type), intent(in) :: sv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver, global_num
end subroutine amg_c_jac_solver_dmp
end interface
interface
subroutine amg_c_jac_solver_clone(sv,svout,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_solver_type, amg_c_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_jac_solver_clone
end interface
!!$ interface
!!$ subroutine amg_c_l1_jac_solver_clone(sv,svout,info)
!!$ import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
!!$ & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
!!$ & amg_c_base_solver_type, amg_c_l1_jac_solver_type, psb_ipk_
!!$ Implicit None
!!$
!!$ ! Arguments
!!$ class(amg_c_l1_jac_solver_type), intent(inout) :: sv
!!$ class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_c_l1_jac_solver_clone
!!$ end interface
interface
subroutine amg_c_jac_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_solver_type, amg_c_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
class(amg_c_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_jac_solver_clone_settings
end interface
interface
subroutine amg_c_jac_solver_clear_data(sv,info)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_jac_solver_clear_data
end interface
contains
subroutine c_jac_solver_default(sv)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
sv%sweeps = ione
sv%eps = dzero
return
end subroutine c_jac_solver_default
subroutine c_jac_solver_check(sv,info)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_jac_solver_check'
call psb_erractionsave(err_act)
info = psb_success_
call amg_check_def(sv%sweeps,&
& 'Jacobi sweeps',ione,is_int_positive)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_jac_solver_check
subroutine c_jac_solver_cseti(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_jac_solver_cseti'
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(what))
case('SOLVER_SWEEPS')
sv%sweeps = val
case default
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_jac_solver_cseti
subroutine c_jac_solver_csetc(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='c_jac_solver_csetc'
info = psb_success_
call psb_erractionsave(err_act)
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info, name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_jac_solver_csetc
subroutine c_jac_solver_csetr(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_jac_solver_csetr'
call psb_erractionsave(err_act)
info = psb_success_
select case(psb_toupper(what))
case('SOLVER_EPS')
sv%eps = val
case default
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_jac_solver_csetr
subroutine c_jac_solver_free(sv,info)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_jac_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
call sv%a%free()
if (allocated(sv%dv)) then
call sv%dv%free(info)
deallocate(sv%dv)
end if
if (allocated(sv%d)) deallocate(sv%d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_jac_solver_free
subroutine c_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_c_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_jac_solver_descr
function c_jac_solver_get_nzeros(sv) result(val)
implicit none
! Arguments
class(amg_c_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = 0
val = val + sv%a%get_nzeros()
val = val + sv%dv%get_nrows()
return
end function c_jac_solver_get_nzeros
function c_jac_solver_sizeof(sv) result(val)
implicit none
! Arguments
class(amg_c_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = psb_sizeof_ip
val = val + sv%a%sizeof()
val = val + sv%dv%sizeof()
return
end function c_jac_solver_sizeof
function c_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Jacobi solver"
end function c_jac_solver_get_fmt
function c_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_jac_
end function c_jac_solver_get_id
!
! If this is true, then the solver needs a starting
! guess. Currently only handled in JAC smoother.
!
function c_jac_solver_is_iterative() result(val)
implicit none
logical :: val
val = .true.
end function c_jac_solver_is_iterative
function c_jac_solver_get_wrksize() result(val)
implicit none
integer(psb_ipk_) :: val
val = 2
end function c_jac_solver_get_wrksize
subroutine c_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_c_l1_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_l1_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine c_l1_jac_solver_descr
function c_l1_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "L1-Jacobi solver"
end function c_l1_jac_solver_get_fmt
function c_l1_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_l1_jac_
end function c_l1_jac_solver_get_id
end module amg_c_jac_solver
+17 -18
View File
@@ -23,7 +23,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
@@ -57,7 +57,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
@@ -436,7 +436,7 @@ contains
val = "KRM solver"
end function c_krm_solver_get_fmt
subroutine c_krm_solver_descr(sv,info,iout,coarse,prefix)
subroutine c_krm_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -444,14 +444,12 @@ contains
class(amg_c_krm_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_c_krm_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -460,22 +458,23 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%global) then
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
write(iout_,*) ' Krylov solver (global)'
else
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
write(iout_,*) ' Krylov solver (local) '
end if
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
write(iout_,*) ' method: ',sv%method
write(iout_,*) ' kprec: ',sv%kprec
if (sv%i_sub_solve > 0) then
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
else
write(iout_,*) ' sub_solve: ',sv%sub_solve
end if
write(iout_,*) ' itmax: ',sv%itmax
write(iout_,*) ' eps: ',sv%eps
write(iout_,*) ' fillin: ',sv%fillin
call psb_erractionrestore(err_act)
return
+19 -27
View File
@@ -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
@@ -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
+3 -35
View File
@@ -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
@@ -187,10 +187,8 @@ module amg_c_onelev_mod
procedure, pass(lv) :: clone => c_base_onelev_clone
procedure, pass(lv) :: cnv => amg_c_base_onelev_cnv
procedure, pass(lv) :: descr => amg_c_base_onelev_descr
procedure, pass(lv) :: memory_use => amg_c_base_onelev_memory_use
procedure, pass(lv) :: default => c_base_onelev_default
procedure, pass(lv) :: free => amg_c_base_onelev_free
procedure, pass(lv) :: free_smoothers => amg_c_base_onelev_free_smoothers
procedure, pass(lv) :: nullify => c_base_onelev_nullify
procedure, pass(lv) :: check => amg_c_base_onelev_check
procedure, pass(lv) :: dump => amg_c_base_onelev_dump
@@ -259,7 +257,7 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@@ -270,27 +268,9 @@ module amg_c_onelev_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_c_base_onelev_descr
end interface
interface
subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_c_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_c_base_onelev_memory_use
end interface
interface
subroutine amg_c_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_c_onelev_type, psb_c_base_vect_type, psb_spk_, &
@@ -304,7 +284,7 @@ module amg_c_onelev_mod
end subroutine amg_c_base_onelev_cnv
end interface
interface
interface
subroutine amg_c_base_onelev_free(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
@@ -316,18 +296,6 @@ module amg_c_onelev_mod
end subroutine amg_c_base_onelev_free
end interface
interface
subroutine amg_c_base_onelev_free_smoothers(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none
class(amg_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_base_onelev_free_smoothers
end interface
interface
subroutine amg_c_base_onelev_check(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
+1 -1
View File
@@ -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
+4 -99
View File
@@ -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
@@ -113,7 +113,6 @@ 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
@@ -136,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,&
@@ -159,35 +155,18 @@ module amg_c_prec_type
interface amg_precdescr
subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity,prefix)
subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity)
import :: amg_cprec_type, psb_ipk_
implicit none
! Arguments
class(amg_cprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
class(amg_cprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_cfile_prec_descr
end interface
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
@@ -365,14 +344,6 @@ module amg_c_prec_type
end subroutine amg_c_smoothers_bld
end interface amg_smoothers_bld
interface amg_smoothers_free
module procedure amg_c_smoothers_free
end interface amg_smoothers_free
interface amg_hierarchy_free
module procedure amg_c_hierarchy_free
end interface amg_hierarchy_free
contains
!
! Function returning a pointer to the smoother
@@ -646,72 +617,6 @@ contains
end subroutine amg_c_prec_free
subroutine amg_c_smoothers_free(prec,info)
implicit none
! Arguments
class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
info=psb_success_
name = 'amg_c_smoothers_free'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
!
! In the internals, do FREE on components,
! but do not deallocate them
!
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
call prec%precv(i)%free_smoothers(info)
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_c_smoothers_free
subroutine amg_c_hierarchy_free(prec,info)
implicit none
! Arguments
class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
info=psb_success_
name = 'amg_c_hierarchy_free'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
write(0,*) 'Missing implementation '
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_c_hierarchy_free
!
+212 -275
View File
@@ -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(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_slu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
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
+5 -14
View File
@@ -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
-23
View File
@@ -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
+107
View File
@@ -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
+6 -14
View File
@@ -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
@@ -58,10 +58,12 @@ 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
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 +85,6 @@ module amg_d_ainv_solver
end subroutine amg_d_ainv_solver_clone
end interface
interface
subroutine amg_d_ainv_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& amg_d_base_solver_type, psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
Implicit None
class(amg_d_ainv_solver_type), intent(inout) :: sv
class(amg_d_base_solver_type), 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)
@@ -206,7 +198,7 @@ module amg_d_ainv_solver
!!$ end interface
interface
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
Implicit None
@@ -216,7 +208,7 @@ module amg_d_ainv_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_d_ainv_solver_descr
end interface
+10 -17
View File
@@ -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
@@ -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)
+5 -13
View File
@@ -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
@@ -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
@@ -486,7 +479,6 @@ contains
integer(psb_ipk_) :: err_act
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.
+1 -1
View File
@@ -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 -3
View File
@@ -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
@@ -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
+3 -3
View File
@@ -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
@@ -270,7 +270,7 @@ module amg_d_base_solver_mod
end interface
interface
subroutine amg_d_base_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_d_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_solver_type, psb_ipk_
@@ -281,7 +281,7 @@ module amg_d_base_solver_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_d_base_solver_descr
end interface
+6 -14
View File
@@ -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
+7 -21
View File
@@ -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
@@ -219,7 +219,7 @@ contains
end subroutine d_diag_solver_free
subroutine d_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -228,13 +228,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -242,13 +240,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Diagonal local solver '
write(iout_,*) ' Diagonal local solver '
return
@@ -359,7 +352,7 @@ module amg_d_l1_diag_solver
contains
subroutine d_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_l1_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -368,13 +361,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_l1_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -382,13 +373,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
write(iout_,*) ' L1 Diagonal solver '
return
+13 -27
View File
@@ -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
@@ -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
+125
View File
@@ -0,0 +1,125 @@
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! 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:
! 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
+4 -11
View File
@@ -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
@@ -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
+1 -1
View File
@@ -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
+15 -22
View File
@@ -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
@@ -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 -3
View File
@@ -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
@@ -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(:)
+3 -15
View File
@@ -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,6 @@ module amg_d_invk_solver
contains
procedure, pass(sv) :: check => amg_d_invk_solver_check
procedure, pass(sv) :: clone => amg_d_invk_solver_clone
procedure, pass(sv) :: clone_settings => amg_d_invk_solver_clone_settings
procedure, pass(sv) :: build => amg_d_invk_solver_bld
procedure, pass(sv) :: cseti => amg_d_invk_solver_cseti
procedure, pass(sv) :: descr => amg_d_invk_solver_descr
@@ -74,17 +73,6 @@ module amg_d_invk_solver
end subroutine amg_d_invk_solver_clone
end interface
interface
subroutine amg_d_invk_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& amg_d_base_solver_type, psb_dpk_, amg_d_invk_solver_type, psb_ipk_
Implicit None
class(amg_d_invk_solver_type), intent(inout) :: sv
class(amg_d_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_invk_solver_clone_settings
end interface
interface
subroutine amg_d_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
@@ -135,7 +123,7 @@ module amg_d_invk_solver
end interface
interface
subroutine amg_d_invk_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_d_invk_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_d_invk_solver_type, psb_ipk_
Implicit None
@@ -145,7 +133,7 @@ module amg_d_invk_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_d_invk_solver_descr
end interface
+5 -18
View File
@@ -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,6 @@ module amg_d_invt_solver
contains
procedure, pass(sv) :: check => amg_d_invt_solver_check
procedure, pass(sv) :: clone => amg_d_invt_solver_clone
procedure, pass(sv) :: clone_settings => amg_d_invt_solver_clone_settings
procedure, pass(sv) :: build => amg_d_invt_solver_bld
procedure, pass(sv) :: cseti => amg_d_invt_solver_cseti
procedure, pass(sv) :: csetr => amg_d_invt_solver_csetr
@@ -74,17 +73,6 @@ module amg_d_invt_solver
end subroutine amg_d_invt_solver_clone
end interface
interface
subroutine amg_d_invt_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& amg_d_base_solver_type, psb_dpk_, amg_d_invt_solver_type, psb_ipk_
Implicit None
class(amg_d_invt_solver_type), intent(inout) :: sv
class(amg_d_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_invt_solver_clone_settings
end interface
interface
subroutine amg_d_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
@@ -146,17 +134,16 @@ module amg_d_invt_solver
end interface
interface
subroutine amg_d_invt_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_d_invt_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_d_invt_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_d_invt_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine amg_d_invt_solver_descr
end interface
+10 -11
View File
@@ -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
@@ -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
@@ -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
@@ -345,6 +343,7 @@ contains
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)
-585
View File
@@ -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(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_d_jac_solver_bld
end interface
interface
subroutine amg_d_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_d_l1_jac_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_d_l1_jac_solver_bld
end interface
interface
subroutine amg_d_jac_solver_cnv(sv,info,amold,vmold,imold)
import :: amg_d_jac_solver_type, psb_dpk_, &
& psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
class(amg_d_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_d_jac_solver_cnv
end interface
interface
subroutine amg_d_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
& psb_ipk_
implicit none
class(amg_d_jac_solver_type), intent(in) :: sv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver, global_num
end subroutine amg_d_jac_solver_dmp
end interface
interface
subroutine amg_d_jac_solver_clone(sv,svout,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_solver_type, amg_d_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_jac_solver_clone
end interface
!!$ interface
!!$ subroutine amg_d_l1_jac_solver_clone(sv,svout,info)
!!$ import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
!!$ & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
!!$ & amg_d_base_solver_type, amg_d_l1_jac_solver_type, psb_ipk_
!!$ Implicit None
!!$
!!$ ! Arguments
!!$ class(amg_d_l1_jac_solver_type), intent(inout) :: sv
!!$ class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_d_l1_jac_solver_clone
!!$ end interface
interface
subroutine amg_d_jac_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_solver_type, amg_d_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
class(amg_d_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_jac_solver_clone_settings
end interface
interface
subroutine amg_d_jac_solver_clear_data(sv,info)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_jac_solver_clear_data
end interface
contains
subroutine d_jac_solver_default(sv)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
sv%sweeps = ione
sv%eps = dzero
return
end subroutine d_jac_solver_default
subroutine d_jac_solver_check(sv,info)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_jac_solver_check'
call psb_erractionsave(err_act)
info = psb_success_
call amg_check_def(sv%sweeps,&
& 'Jacobi sweeps',ione,is_int_positive)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_jac_solver_check
subroutine d_jac_solver_cseti(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_jac_solver_cseti'
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(what))
case('SOLVER_SWEEPS')
sv%sweeps = val
case default
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_jac_solver_cseti
subroutine d_jac_solver_csetc(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='d_jac_solver_csetc'
info = psb_success_
call psb_erractionsave(err_act)
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info, name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_jac_solver_csetc
subroutine d_jac_solver_csetr(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_jac_solver_csetr'
call psb_erractionsave(err_act)
info = psb_success_
select case(psb_toupper(what))
case('SOLVER_EPS')
sv%eps = val
case default
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_jac_solver_csetr
subroutine d_jac_solver_free(sv,info)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_jac_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
call sv%a%free()
if (allocated(sv%dv)) then
call sv%dv%free(info)
deallocate(sv%dv)
end if
if (allocated(sv%d)) deallocate(sv%d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_jac_solver_free
subroutine d_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_d_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_jac_solver_descr
function d_jac_solver_get_nzeros(sv) result(val)
implicit none
! Arguments
class(amg_d_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = 0
val = val + sv%a%get_nzeros()
val = val + sv%dv%get_nrows()
return
end function d_jac_solver_get_nzeros
function d_jac_solver_sizeof(sv) result(val)
implicit none
! Arguments
class(amg_d_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = psb_sizeof_ip
val = val + sv%a%sizeof()
val = val + sv%dv%sizeof()
return
end function d_jac_solver_sizeof
function d_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Jacobi solver"
end function d_jac_solver_get_fmt
function d_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_jac_
end function d_jac_solver_get_id
!
! If this is true, then the solver needs a starting
! guess. Currently only handled in JAC smoother.
!
function d_jac_solver_is_iterative() result(val)
implicit none
logical :: val
val = .true.
end function d_jac_solver_is_iterative
function d_jac_solver_get_wrksize() result(val)
implicit none
integer(psb_ipk_) :: val
val = 2
end function d_jac_solver_get_wrksize
subroutine d_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_d_l1_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_l1_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_l1_jac_solver_descr
function d_l1_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "L1-Jacobi solver"
end function d_l1_jac_solver_get_fmt
function d_l1_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_l1_jac_
end function d_l1_jac_solver_get_id
end module amg_d_jac_solver
+17 -18
View File
@@ -23,7 +23,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
@@ -57,7 +57,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
@@ -436,7 +436,7 @@ contains
val = "KRM solver"
end function d_krm_solver_get_fmt
subroutine d_krm_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_krm_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -444,14 +444,12 @@ contains
class(amg_d_krm_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_d_krm_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -460,22 +458,23 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%global) then
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
write(iout_,*) ' Krylov solver (global)'
else
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
write(iout_,*) ' Krylov solver (local) '
end if
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
write(iout_,*) ' method: ',sv%method
write(iout_,*) ' kprec: ',sv%kprec
if (sv%i_sub_solve > 0) then
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
else
write(iout_,*) ' sub_solve: ',sv%sub_solve
end if
write(iout_,*) ' itmax: ',sv%itmax
write(iout_,*) ' eps: ',sv%eps
write(iout_,*) ' fillin: ',sv%fillin
call psb_erractionrestore(err_act)
return
@@ -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
@@ -54,7 +54,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
@@ -73,22 +73,6 @@ module amg_d_matchboxp_mod
use iso_c_binding
use psb_base_cbind_mod
#if defined(PSB_SERIAL_MPI)
interface MatchingC
subroutine dMatchingC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate) bind(c,name='dMatching')
use iso_c_binding
import :: psb_c_ipk_, psb_c_lpk_
implicit none
integer(psb_c_lpk_), value :: nlver,nledge
integer(psb_c_lpk_) :: verlocptr(*),verlocind(*), verdistance(*)
integer(psb_c_lpk_) :: mate(*)
real(c_double) :: edgelocweight(*)
end subroutine dMatchingC
end interface MatchingC
#else
interface MatchBoxPC
subroutine dMatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate, myrank, numprocs, icomm,&
@@ -109,7 +93,7 @@ module amg_d_matchboxp_mod
real(c_double) :: msgpercent(*)
end subroutine dMatchBoxPC
end interface MatchBoxPC
#endif
interface amg_i_aggr_assign
module procedure amg_i_d_aggr_assign
end interface amg_i_aggr_assign
@@ -159,10 +143,9 @@ contains
type(psb_ld_coo_sparse_mat) :: tmpcoo
logical :: display_out_, print_out_, reproducible_
logical, parameter :: dump=.false., debug=.false., dump_mate=.false., &
& debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
& debug_ilaggr=.false., debug_sync=.false.
integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
logical, parameter :: do_timings=.false.
integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
logical, parameter :: do_timings=.true.
ictxt = desc_a%get_ctxt()
call psb_info(ictxt,iam,np)
@@ -204,7 +187,7 @@ contains
call desc_a%l2gip(ilv,info,owned=.false.)
call psb_geall(ilaggr,desc_a,info)
ilaggr = ilaggr_neginit
ilaggr = -1
call psb_geasb(ilaggr,desc_a,info)
nr = a%get_nrows()
nc = a%get_ncols()
@@ -230,20 +213,7 @@ contains
call psb_barrier(ictxt)
if (iam == 0) write(0,*)' out from buildmatching:', info
end if
if (debug_mate) then
block
integer(psb_lpk_), allocatable :: ckmate(:)
allocate(ckmate(nr))
ckmate(1:nr) = mate(1:nr)
call psb_msort(ckmate(1:nr))
do i=1,nr-1
if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
write(0,*) iam,' Duplicate mate entry at',i,' :',ckmate(i)
end if
end do
end block
end if
if (info == 0) then
if (do_timings) call psb_tic(idx_phase2)
if (debug_sync) then
@@ -289,7 +259,7 @@ contains
cycle
else
if (ilaggr(k) == ilaggr_neginit) then
if (ilaggr(k) == -1) then
wk = w(k)
widx = w(idx)
@@ -297,7 +267,7 @@ contains
nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
if (nrmagg > epsilon(nrmagg)) then
if (idx <= nr) then
if (ilaggr(idx) == ilaggr_neginit) then
if (ilaggr(idx) == -1) then
! Now, if both vertices are local, the aggregate is local
! (kinda obvious).
nlaggr(iam) = nlaggr(iam) + 1
@@ -305,9 +275,6 @@ contains
ilaggr(idx) = nlaggr(iam)
wtemp(k) = w(k)/nrmagg
wtemp(idx) = w(idx)/nrmagg
else
write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
&mate(idx),ilaggr(idx)
end if
nlpairs = nlpairs+1
else if (idx <= nc) then
@@ -327,7 +294,7 @@ contains
ilaggr(k) = nlaggr(iam)
nlpairs = nlpairs+1
else
ilaggr(k) = ilaggr_nonlocal
ilaggr(k) = -2
end if
else
! Use a statistically unbiased tie-breaking rule,
@@ -342,7 +309,7 @@ contains
ilaggr(k) = nlaggr(iam)
nlpairs = nlpairs+1
else
ilaggr(k) = ilaggr_nonlocal
ilaggr(k) = -2
end if
end if
end if
@@ -358,12 +325,6 @@ contains
nlsingl = nlsingl + 1
end if
end if
if (ilaggr(k) == ilaggr_neginit) then
write(0,*) iam,' Error: no update to ',k,mate(k),&
& abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
end if
else
if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
end if
end if
end do
@@ -371,7 +332,7 @@ contains
if (do_timings) call psb_tic(idx_phase3)
! Ok, now compute offsets, gather halo and fix non-local
! aggregates (those where ilaggr == ilaggr_nonlocal)
! aggregates (those where ilaggr == -2)
call psb_sum(ictxt,nlaggr)
ntaggr = sum(nlaggr(0:np-1))
naggrm1 = sum(nlaggr(0:iam-1))
@@ -386,7 +347,7 @@ contains
call psb_halo(wtemp,desc_a,info)
! Cleanup as yet unmarked entries
do k=1,nr
if (ilaggr(k) == ilaggr_nonlocal) then
if (ilaggr(k) == -2) then
idx = mate(k)
if (idx > nr) then
i = ilaggr(idx)
@@ -398,14 +359,9 @@ contains
else
write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
end if
else if (ilaggr(k) <0) then
write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
write(0,*) iam,' : : ',nr,nc,mate(k)
if (mate(k) <= nr) then
write(0,*) iam,' : : ',ilaggr(mate(k)),mate(mate(k)),&
& ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
end if
flush(0)
end if
if (ilaggr(k) <0) then
write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
end if
end do
if (debug_sync) then
@@ -458,7 +414,7 @@ contains
end block
if (iam == 0) then
write(0,*) iam,'Matching statistics: Unmatched nodes ',&
write(0,*) 'Matching statistics: Unmatched nodes ',&
& nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
end if
@@ -624,7 +580,7 @@ contains
logical, parameter :: old_style=.false., sort_minp=.true.
character(len=40) :: name='build_matching', fname
integer(psb_ipk_), save :: idx_cmboxp=-1, idx_bldahat=-1, idx_phase2=-1, idx_phase3=-1
logical, parameter :: do_timings=.false.
logical, parameter :: do_timings=.true.
ictxt = desc_a%get_ctxt()
call psb_info(ictxt,iam,np)
@@ -826,7 +782,7 @@ contains
character(len=80) :: aname
real(psb_dpk_), parameter :: eps=epsilon(1.d0)
integer(psb_ipk_), save :: idx_glbt=-1, idx_phase1=-1, idx_phase2=-1
logical, parameter :: do_timings=.false.
logical, parameter :: do_timings=.true.
logical, parameter :: debug_symmetry = .false., check_size=.false.
logical, parameter :: unroll_logtrans=.false.
@@ -879,7 +835,7 @@ contains
nr = tcoo1%get_nrows()
nc = tcoo1%get_ncols()
nz = tcoo1%get_nzeros()
call tcoo2%allocate(nr,nc,int(1.25*nz,psb_ipk_))
call tcoo2%allocate(nr,nc,int(1.25*nz))
k2 = 0
!
! Build the entries of \^A for matching
@@ -1056,8 +1012,7 @@ contains
integer(psb_c_lpk_) :: ph1_card(*),ph2_card(*)
real(c_double) :: edgelocweight(:)
real(c_double) :: msgpercent(*)
integer(psb_ipk_) :: info
integer(psb_mpk_) :: me, np
integer(psb_ipk_) :: info, me, np
integer(psb_c_mpk_) :: icomm, mrank, mnp
logical, optional :: display_inp
!
@@ -1146,15 +1101,11 @@ contains
call psb_barrier(ictxt)
if (me == 0) write(0,*)' Calling MatchBoxP '
end if
#if defined(PSB_SERIAL_MPI)
call MatchingC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate)
#else
call MatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate, mrank, mnp, icomm,&
& msgindsent,msgactualsent,msgpercent,&
& ph0_time, ph1_time, ph2_time, ph1_card, ph2_card)
#endif
verlocptr(:) = verlocptr(:) + 1
verlocind(:) = verlocind(:) + 1
verdistance(:) = verdistance(:) + 1
+19 -27
View File
@@ -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
@@ -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
+3 -35
View File
@@ -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
@@ -188,10 +188,8 @@ module amg_d_onelev_mod
procedure, pass(lv) :: clone => d_base_onelev_clone
procedure, pass(lv) :: cnv => amg_d_base_onelev_cnv
procedure, pass(lv) :: descr => amg_d_base_onelev_descr
procedure, pass(lv) :: memory_use => amg_d_base_onelev_memory_use
procedure, pass(lv) :: default => d_base_onelev_default
procedure, pass(lv) :: free => amg_d_base_onelev_free
procedure, pass(lv) :: free_smoothers => amg_d_base_onelev_free_smoothers
procedure, pass(lv) :: nullify => d_base_onelev_nullify
procedure, pass(lv) :: check => amg_d_base_onelev_check
procedure, pass(lv) :: dump => amg_d_base_onelev_dump
@@ -260,7 +258,7 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@@ -271,27 +269,9 @@ module amg_d_onelev_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_d_base_onelev_descr
end interface
interface
subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_d_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_d_base_onelev_memory_use
end interface
interface
subroutine amg_d_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_d_onelev_type, psb_d_base_vect_type, psb_dpk_, &
@@ -305,7 +285,7 @@ module amg_d_onelev_mod
end subroutine amg_d_base_onelev_cnv
end interface
interface
interface
subroutine amg_d_base_onelev_free(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
@@ -317,18 +297,6 @@ module amg_d_onelev_mod
end subroutine amg_d_base_onelev_free
end interface
interface
subroutine amg_d_base_onelev_free_smoothers(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none
class(amg_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_base_onelev_free_smoothers
end interface
interface
subroutine amg_d_base_onelev_check(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
+22 -24
View File
@@ -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
@@ -54,7 +54,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,6 +119,10 @@
module amg_d_parmatch_aggregator_mod
use amg_d_base_aggregator_mod
use amg_d_matchboxp_mod
#if defined(SERIAL_MPI)
type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
end type amg_d_parmatch_aggregator_type
#else
type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
integer(psb_ipk_) :: matching_alg
integer(psb_ipk_) :: n_sweeps ! When n_sweeps >1 we need an auxiliary descriptor
@@ -240,12 +244,11 @@ module amg_d_parmatch_aggregator_mod
end interface
interface
subroutine amg_d_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
subroutine amg_d_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
implicit none
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
@@ -259,12 +262,11 @@ module amg_d_parmatch_aggregator_mod
end interface
interface
subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
implicit none
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
@@ -388,26 +390,18 @@ contains
end function amg_d_parmatch_aggregator_sizeof
subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_d_parmatch_aggregator_type), intent(in) :: ag
type(amg_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
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)
write(iout,*) 'Parallel Matching Aggregator'
write(iout,*) ' Number of matching sweeps: ',ag%n_sweeps
write(iout,*) ' Matching algorithm : MatchBoxP (PREIS)'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_d_parmatch_aggregator_descr
@@ -448,7 +442,6 @@ contains
class(amg_d_base_aggregator_type), target, intent(inout) :: agnext
integer(psb_ipk_), intent(out) :: info
info = psb_success_
!
!
select type(agnext)
@@ -588,7 +581,7 @@ contains
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
integer(psb_ipk_), intent(out) :: info
info = psb_success_
info = 0
if ((info == 0).and.allocated(ag%w)) deallocate(ag%w,stat=info)
if ((info == 0).and.allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info)
if ((info == 0).and.allocated(ag%prol)) then
@@ -627,7 +620,7 @@ contains
class(amg_d_base_aggregator_type), allocatable, intent(inout) :: agnext
integer(psb_ipk_), intent(out) :: info
info = psb_success_
info = 0
if (allocated(agnext)) then
call agnext%free(info)
if (info == 0) deallocate(agnext,stat=info)
@@ -656,7 +649,6 @@ contains
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_parmatch_aggregator_bld_map'
info = psb_success_
call psb_erractionsave(err_act)
!
! Copy the prolongation/restriction matrices into the descriptor map.
@@ -674,6 +666,11 @@ contains
map = psb_linmap(psb_map_gen_linear_,desc_a,&
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
end if
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999
end if
call psb_erractionrestore(err_act)
return
@@ -681,4 +678,5 @@ contains
return
end subroutine amg_d_parmatch_aggregator_bld_map
#endif
end module amg_d_parmatch_aggregator_mod
-548
View File
@@ -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
-373
View File
@@ -1,373 +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(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
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_) 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
+1 -1
View File
@@ -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
+4 -99
View File
@@ -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
@@ -113,7 +113,6 @@ 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
@@ -136,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,&
@@ -159,35 +155,18 @@ module amg_d_prec_type
interface amg_precdescr
subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity,prefix)
subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity)
import :: amg_dprec_type, psb_ipk_
implicit none
! Arguments
class(amg_dprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
class(amg_dprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_dfile_prec_descr
end interface
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
@@ -365,14 +344,6 @@ module amg_d_prec_type
end subroutine amg_d_smoothers_bld
end interface amg_smoothers_bld
interface amg_smoothers_free
module procedure amg_d_smoothers_free
end interface amg_smoothers_free
interface amg_hierarchy_free
module procedure amg_d_hierarchy_free
end interface amg_hierarchy_free
contains
!
! Function returning a pointer to the smoother
@@ -646,72 +617,6 @@ contains
end subroutine amg_d_prec_free
subroutine amg_d_smoothers_free(prec,info)
implicit none
! Arguments
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
info=psb_success_
name = 'amg_d_smoothers_free'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
!
! In the internals, do FREE on components,
! but do not deallocate them
!
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
call prec%precv(i)%free_smoothers(info)
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_d_smoothers_free
subroutine amg_d_hierarchy_free(prec,info)
implicit none
! Arguments
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
info=psb_success_
name = 'amg_d_hierarchy_free'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
write(0,*) 'Missing implementation '
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine amg_d_hierarchy_free
!
+212 -275
View File
@@ -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(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_slu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
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
+10 -16
View File
@@ -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(HAVE_SLUDIST_)) || defined(IPK8)
type, extends(amg_d_base_solver_type) :: amg_d_sludist_solver_type
@@ -270,13 +270,13 @@ contains
! Local variables
type(psb_dspmat_type) :: atmp
type(psb_d_csr_sparse_mat) :: acsr
type(psb_ctxt_type) :: ctxt
integer(psb_lpk_), allocatable :: gia(:), gja(:)
type(psb_ctxt_type) :: ctxt
integer(psb_lpk_) :: lfrst
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
integer(psb_ipk_) :: ifrst, ibcheck
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_sludist_solver_bld', ch_err
character(len=20) :: name='d_sludist_solver_bld', ch_err
info=psb_success_
call psb_erractionsave(err_act)
@@ -325,6 +325,7 @@ contains
acsr%ja(:) = acsr%ja(:) - 1
acsr%irp(:) = acsr%irp(:) - 1
ifrst = lfrst - 1
info = amg_dsludist_fact(nglob,nrow_a,nztota,ifrst,&
& acsr%val,acsr%irp,acsr%ja,sv%lufactors,&
& npr,npc)
@@ -421,16 +422,15 @@ contains
end subroutine d_sludist_solver_finalize
subroutine d_sludist_solver_descr(sv,info,iout,coarse,prefix)
subroutine d_sludist_solver_descr(sv,info,iout,coarse)
Implicit None
! Arguments
class(amg_d_sludist_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
@@ -438,7 +438,6 @@ contains
integer :: me, np
character(len=20), parameter :: name='amg_d_sludist_solver_descr'
integer :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -447,13 +446,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' SuperLU_Dist Sparse Factorization Solver. '
write(iout_,*) ' SuperLU_Dist Sparse Factorization Solver. '
call psb_erractionrestore(err_act)
return
+5 -14
View File
@@ -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
+213 -76
View File
@@ -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(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_umf_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
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
+1 -1
View File
@@ -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 -1
View File
@@ -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
+6 -14
View File
@@ -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
@@ -58,10 +58,12 @@ 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
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 +85,6 @@ module amg_s_ainv_solver
end subroutine amg_s_ainv_solver_clone
end interface
interface
subroutine amg_s_ainv_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& amg_s_base_solver_type, psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
Implicit None
class(amg_s_ainv_solver_type), intent(inout) :: sv
class(amg_s_base_solver_type), 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)
@@ -206,7 +198,7 @@ module amg_s_ainv_solver
!!$ end interface
interface
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse)
import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
Implicit None
@@ -216,7 +208,7 @@ module amg_s_ainv_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_s_ainv_solver_descr
end interface
+10 -17
View File
@@ -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
@@ -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)
+5 -13
View File
@@ -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
@@ -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
@@ -486,7 +479,6 @@ contains
integer(psb_ipk_) :: err_act
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.
+1 -1
View File
@@ -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 -3
View File
@@ -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
@@ -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
+3 -3
View File
@@ -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
@@ -270,7 +270,7 @@ module amg_s_base_solver_mod
end interface
interface
subroutine amg_s_base_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_s_base_solver_descr(sv,info,iout,coarse)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_solver_type, psb_ipk_
@@ -281,7 +281,7 @@ module amg_s_base_solver_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_s_base_solver_descr
end interface
+6 -14
View File
@@ -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
+7 -21
View File
@@ -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
@@ -219,7 +219,7 @@ contains
end subroutine s_diag_solver_free
subroutine s_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine s_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -228,13 +228,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -242,13 +240,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' Diagonal local solver '
write(iout_,*) ' Diagonal local solver '
return
@@ -359,7 +352,7 @@ module amg_s_l1_diag_solver
contains
subroutine s_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
subroutine s_l1_diag_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -368,13 +361,11 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_l1_diag_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
info = psb_success_
if (present(iout)) then
@@ -382,13 +373,8 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
write(iout_,*) ' L1 Diagonal solver '
return
+13 -27
View File
@@ -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
@@ -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
+125
View File
@@ -0,0 +1,125 @@
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! 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:
! 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
+4 -11
View File
@@ -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
@@ -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
+1 -1
View File
@@ -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
+15 -22
View File
@@ -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
@@ -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 -3
View File
@@ -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
@@ -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(:)
+3 -15
View File
@@ -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,6 @@ module amg_s_invk_solver
contains
procedure, pass(sv) :: check => amg_s_invk_solver_check
procedure, pass(sv) :: clone => amg_s_invk_solver_clone
procedure, pass(sv) :: clone_settings => amg_s_invk_solver_clone_settings
procedure, pass(sv) :: build => amg_s_invk_solver_bld
procedure, pass(sv) :: cseti => amg_s_invk_solver_cseti
procedure, pass(sv) :: descr => amg_s_invk_solver_descr
@@ -74,17 +73,6 @@ module amg_s_invk_solver
end subroutine amg_s_invk_solver_clone
end interface
interface
subroutine amg_s_invk_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& amg_s_base_solver_type, psb_spk_, amg_s_invk_solver_type, psb_ipk_
Implicit None
class(amg_s_invk_solver_type), intent(inout) :: sv
class(amg_s_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_invk_solver_clone_settings
end interface
interface
subroutine amg_s_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
@@ -135,7 +123,7 @@ module amg_s_invk_solver
end interface
interface
subroutine amg_s_invk_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_s_invk_solver_descr(sv,info,iout,coarse)
import :: psb_spk_, amg_s_invk_solver_type, psb_ipk_
Implicit None
@@ -145,7 +133,7 @@ module amg_s_invk_solver
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
end subroutine amg_s_invk_solver_descr
end interface
+5 -18
View File
@@ -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,6 @@ module amg_s_invt_solver
contains
procedure, pass(sv) :: check => amg_s_invt_solver_check
procedure, pass(sv) :: clone => amg_s_invt_solver_clone
procedure, pass(sv) :: clone_settings => amg_s_invt_solver_clone_settings
procedure, pass(sv) :: build => amg_s_invt_solver_bld
procedure, pass(sv) :: cseti => amg_s_invt_solver_cseti
procedure, pass(sv) :: csetr => amg_s_invt_solver_csetr
@@ -74,17 +73,6 @@ module amg_s_invt_solver
end subroutine amg_s_invt_solver_clone
end interface
interface
subroutine amg_s_invt_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& amg_s_base_solver_type, psb_spk_, amg_s_invt_solver_type, psb_ipk_
Implicit None
class(amg_s_invt_solver_type), intent(inout) :: sv
class(amg_s_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_invt_solver_clone_settings
end interface
interface
subroutine amg_s_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
@@ -146,17 +134,16 @@ module amg_s_invt_solver
end interface
interface
subroutine amg_s_invt_solver_descr(sv,info,iout,coarse,prefix)
subroutine amg_s_invt_solver_descr(sv,info,iout,coarse)
import :: psb_spk_, amg_s_invt_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_s_invt_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
end subroutine amg_s_invt_solver_descr
end interface
+10 -11
View File
@@ -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
@@ -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
@@ -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
@@ -345,6 +343,7 @@ contains
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)
-585
View File
@@ -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(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_s_jac_solver_bld
end interface
interface
subroutine amg_s_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
import :: psb_desc_type, amg_s_l1_jac_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_s_l1_jac_solver_bld
end interface
interface
subroutine amg_s_jac_solver_cnv(sv,info,amold,vmold,imold)
import :: amg_s_jac_solver_type, psb_spk_, &
& psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
class(amg_s_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_s_jac_solver_cnv
end interface
interface
subroutine amg_s_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
& psb_ipk_
implicit none
class(amg_s_jac_solver_type), intent(in) :: sv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver, global_num
end subroutine amg_s_jac_solver_dmp
end interface
interface
subroutine amg_s_jac_solver_clone(sv,svout,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_solver_type, amg_s_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_jac_solver_clone
end interface
!!$ interface
!!$ subroutine amg_s_l1_jac_solver_clone(sv,svout,info)
!!$ import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
!!$ & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
!!$ & amg_s_base_solver_type, amg_s_l1_jac_solver_type, psb_ipk_
!!$ Implicit None
!!$
!!$ ! Arguments
!!$ class(amg_s_l1_jac_solver_type), intent(inout) :: sv
!!$ class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine amg_s_l1_jac_solver_clone
!!$ end interface
interface
subroutine amg_s_jac_solver_clone_settings(sv,svout,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_solver_type, amg_s_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
class(amg_s_base_solver_type), intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_jac_solver_clone_settings
end interface
interface
subroutine amg_s_jac_solver_clear_data(sv,info)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_jac_solver_type, psb_ipk_
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_jac_solver_clear_data
end interface
contains
subroutine s_jac_solver_default(sv)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
sv%sweeps = ione
sv%eps = dzero
return
end subroutine s_jac_solver_default
subroutine s_jac_solver_check(sv,info)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_jac_solver_check'
call psb_erractionsave(err_act)
info = psb_success_
call amg_check_def(sv%sweeps,&
& 'Jacobi sweeps',ione,is_int_positive)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_jac_solver_check
subroutine s_jac_solver_cseti(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_jac_solver_cseti'
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(what))
case('SOLVER_SWEEPS')
sv%sweeps = val
case default
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_jac_solver_cseti
subroutine s_jac_solver_csetc(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='s_jac_solver_csetc'
info = psb_success_
call psb_erractionsave(err_act)
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info, name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_jac_solver_csetc
subroutine s_jac_solver_csetr(sv,what,val,info,idx)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: idx
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_jac_solver_csetr'
call psb_erractionsave(err_act)
info = psb_success_
select case(psb_toupper(what))
case('SOLVER_EPS')
sv%eps = val
case default
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
end select
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_jac_solver_csetr
subroutine s_jac_solver_free(sv,info)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_jac_solver_free'
call psb_erractionsave(err_act)
info = psb_success_
call sv%a%free()
if (allocated(sv%dv)) then
call sv%dv%free(info)
deallocate(sv%dv)
end if
if (allocated(sv%d)) deallocate(sv%d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_jac_solver_free
subroutine s_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_s_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_jac_solver_descr
function s_jac_solver_get_nzeros(sv) result(val)
implicit none
! Arguments
class(amg_s_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = 0
val = val + sv%a%get_nzeros()
val = val + sv%dv%get_nrows()
return
end function s_jac_solver_get_nzeros
function s_jac_solver_sizeof(sv) result(val)
implicit none
! Arguments
class(amg_s_jac_solver_type), intent(in) :: sv
integer(psb_epk_) :: val
integer(psb_ipk_) :: i
val = psb_sizeof_ip
val = val + sv%a%sizeof()
val = val + sv%dv%sizeof()
return
end function s_jac_solver_sizeof
function s_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Jacobi solver"
end function s_jac_solver_get_fmt
function s_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_jac_
end function s_jac_solver_get_id
!
! If this is true, then the solver needs a starting
! guess. Currently only handled in JAC smoother.
!
function s_jac_solver_is_iterative() result(val)
implicit none
logical :: val
val = .true.
end function s_jac_solver_is_iterative
function s_jac_solver_get_wrksize() result(val)
implicit none
integer(psb_ipk_) :: val
val = 2
end function s_jac_solver_get_wrksize
subroutine s_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
Implicit None
! Arguments
class(amg_s_l1_jac_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_l1_jac_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%eps<=dzero) then
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with ',&
& sv%sweeps,' sweeps'
else
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with tolerance',&
& sv%eps,' and maxit', sv%sweeps
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine s_l1_jac_solver_descr
function s_l1_jac_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "L1-Jacobi solver"
end function s_l1_jac_solver_get_fmt
function s_l1_jac_solver_get_id() result(val)
implicit none
integer(psb_ipk_) :: val
val = amg_l1_jac_
end function s_l1_jac_solver_get_id
end module amg_s_jac_solver
+17 -18
View File
@@ -23,7 +23,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
@@ -57,7 +57,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
@@ -436,7 +436,7 @@ contains
val = "KRM solver"
end function s_krm_solver_get_fmt
subroutine s_krm_solver_descr(sv,info,iout,coarse,prefix)
subroutine s_krm_solver_descr(sv,info,iout,coarse)
Implicit None
@@ -444,14 +444,12 @@ contains
class(amg_s_krm_solver_type), intent(in) :: sv
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='amg_s_krm_solver_descr'
integer(psb_ipk_) :: iout_
character(1024) :: prefix_
call psb_erractionsave(err_act)
info = psb_success_
@@ -460,22 +458,23 @@ contains
else
iout_ = psb_out_unit
endif
if (present(prefix)) then
prefix_ = prefix
else
prefix_ = ""
end if
if (sv%global) then
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
write(iout_,*) ' Krylov solver (global)'
else
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
write(iout_,*) ' Krylov solver (local) '
end if
write(iout_,*) trim(prefix_), ' method: ',sv%method
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
write(iout_,*) ' method: ',sv%method
write(iout_,*) ' kprec: ',sv%kprec
if (sv%i_sub_solve > 0) then
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
else
write(iout_,*) ' sub_solve: ',sv%sub_solve
end if
write(iout_,*) ' itmax: ',sv%itmax
write(iout_,*) ' eps: ',sv%eps
write(iout_,*) ' fillin: ',sv%fillin
call psb_erractionrestore(err_act)
return
@@ -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
@@ -54,7 +54,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
@@ -73,22 +73,6 @@ module amg_s_matchboxp_mod
use iso_c_binding
use psb_base_cbind_mod
#if defined(PSB_SERIAL_MPI)
interface MatchingC
subroutine sMatchingC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate) bind(c,name='sMatching')
use iso_c_binding
import :: psb_c_ipk_, psb_c_lpk_
implicit none
integer(psb_c_lpk_), value :: nlver,nledge
integer(psb_c_lpk_) :: verlocptr(*),verlocind(*), verdistance(*)
integer(psb_c_lpk_) :: mate(*)
real(c_float) :: edgelocweight(*)
end subroutine sMatchingC
end interface MatchingC
#else
interface MatchBoxPC
subroutine sMatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate, myrank, numprocs, icomm,&
@@ -109,7 +93,7 @@ module amg_s_matchboxp_mod
real(c_double) :: msgpercent(*)
end subroutine sMatchBoxPC
end interface MatchBoxPC
#endif
interface amg_i_aggr_assign
module procedure amg_i_s_aggr_assign
end interface amg_i_aggr_assign
@@ -159,10 +143,9 @@ contains
type(psb_ls_coo_sparse_mat) :: tmpcoo
logical :: display_out_, print_out_, reproducible_
logical, parameter :: dump=.false., debug=.false., dump_mate=.false., &
& debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
& debug_ilaggr=.false., debug_sync=.false.
integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
logical, parameter :: do_timings=.false.
integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
logical, parameter :: do_timings=.true.
ictxt = desc_a%get_ctxt()
call psb_info(ictxt,iam,np)
@@ -204,7 +187,7 @@ contains
call desc_a%l2gip(ilv,info,owned=.false.)
call psb_geall(ilaggr,desc_a,info)
ilaggr = ilaggr_neginit
ilaggr = -1
call psb_geasb(ilaggr,desc_a,info)
nr = a%get_nrows()
nc = a%get_ncols()
@@ -230,20 +213,7 @@ contains
call psb_barrier(ictxt)
if (iam == 0) write(0,*)' out from buildmatching:', info
end if
if (debug_mate) then
block
integer(psb_lpk_), allocatable :: ckmate(:)
allocate(ckmate(nr))
ckmate(1:nr) = mate(1:nr)
call psb_msort(ckmate(1:nr))
do i=1,nr-1
if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
write(0,*) iam,' Duplicate mate entry at',i,' :',ckmate(i)
end if
end do
end block
end if
if (info == 0) then
if (do_timings) call psb_tic(idx_phase2)
if (debug_sync) then
@@ -289,7 +259,7 @@ contains
cycle
else
if (ilaggr(k) == ilaggr_neginit) then
if (ilaggr(k) == -1) then
wk = w(k)
widx = w(idx)
@@ -297,7 +267,7 @@ contains
nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
if (nrmagg > epsilon(nrmagg)) then
if (idx <= nr) then
if (ilaggr(idx) == ilaggr_neginit) then
if (ilaggr(idx) == -1) then
! Now, if both vertices are local, the aggregate is local
! (kinda obvious).
nlaggr(iam) = nlaggr(iam) + 1
@@ -305,9 +275,6 @@ contains
ilaggr(idx) = nlaggr(iam)
wtemp(k) = w(k)/nrmagg
wtemp(idx) = w(idx)/nrmagg
else
write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
&mate(idx),ilaggr(idx)
end if
nlpairs = nlpairs+1
else if (idx <= nc) then
@@ -327,7 +294,7 @@ contains
ilaggr(k) = nlaggr(iam)
nlpairs = nlpairs+1
else
ilaggr(k) = ilaggr_nonlocal
ilaggr(k) = -2
end if
else
! Use a statistically unbiased tie-breaking rule,
@@ -342,7 +309,7 @@ contains
ilaggr(k) = nlaggr(iam)
nlpairs = nlpairs+1
else
ilaggr(k) = ilaggr_nonlocal
ilaggr(k) = -2
end if
end if
end if
@@ -358,12 +325,6 @@ contains
nlsingl = nlsingl + 1
end if
end if
if (ilaggr(k) == ilaggr_neginit) then
write(0,*) iam,' Error: no update to ',k,mate(k),&
& abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
end if
else
if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
end if
end if
end do
@@ -371,7 +332,7 @@ contains
if (do_timings) call psb_tic(idx_phase3)
! Ok, now compute offsets, gather halo and fix non-local
! aggregates (those where ilaggr == ilaggr_nonlocal)
! aggregates (those where ilaggr == -2)
call psb_sum(ictxt,nlaggr)
ntaggr = sum(nlaggr(0:np-1))
naggrm1 = sum(nlaggr(0:iam-1))
@@ -386,7 +347,7 @@ contains
call psb_halo(wtemp,desc_a,info)
! Cleanup as yet unmarked entries
do k=1,nr
if (ilaggr(k) == ilaggr_nonlocal) then
if (ilaggr(k) == -2) then
idx = mate(k)
if (idx > nr) then
i = ilaggr(idx)
@@ -398,14 +359,9 @@ contains
else
write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
end if
else if (ilaggr(k) <0) then
write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
write(0,*) iam,' : : ',nr,nc,mate(k)
if (mate(k) <= nr) then
write(0,*) iam,' : : ',ilaggr(mate(k)),mate(mate(k)),&
& ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
end if
flush(0)
end if
if (ilaggr(k) <0) then
write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
end if
end do
if (debug_sync) then
@@ -458,7 +414,7 @@ contains
end block
if (iam == 0) then
write(0,*) iam,'Matching statistics: Unmatched nodes ',&
write(0,*) 'Matching statistics: Unmatched nodes ',&
& nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
end if
@@ -624,7 +580,7 @@ contains
logical, parameter :: old_style=.false., sort_minp=.true.
character(len=40) :: name='build_matching', fname
integer(psb_ipk_), save :: idx_cmboxp=-1, idx_bldahat=-1, idx_phase2=-1, idx_phase3=-1
logical, parameter :: do_timings=.false.
logical, parameter :: do_timings=.true.
ictxt = desc_a%get_ctxt()
call psb_info(ictxt,iam,np)
@@ -826,7 +782,7 @@ contains
character(len=80) :: aname
real(psb_spk_), parameter :: eps=epsilon(1.d0)
integer(psb_ipk_), save :: idx_glbt=-1, idx_phase1=-1, idx_phase2=-1
logical, parameter :: do_timings=.false.
logical, parameter :: do_timings=.true.
logical, parameter :: debug_symmetry = .false., check_size=.false.
logical, parameter :: unroll_logtrans=.false.
@@ -879,7 +835,7 @@ contains
nr = tcoo1%get_nrows()
nc = tcoo1%get_ncols()
nz = tcoo1%get_nzeros()
call tcoo2%allocate(nr,nc,int(1.25*nz,psb_ipk_))
call tcoo2%allocate(nr,nc,int(1.25*nz))
k2 = 0
!
! Build the entries of \^A for matching
@@ -1056,8 +1012,7 @@ contains
integer(psb_c_lpk_) :: ph1_card(*),ph2_card(*)
real(c_float) :: edgelocweight(:)
real(c_double) :: msgpercent(*)
integer(psb_ipk_) :: info
integer(psb_mpk_) :: me, np
integer(psb_ipk_) :: info, me, np
integer(psb_c_mpk_) :: icomm, mrank, mnp
logical, optional :: display_inp
!
@@ -1146,15 +1101,11 @@ contains
call psb_barrier(ictxt)
if (me == 0) write(0,*)' Calling MatchBoxP '
end if
#if defined(PSB_SERIAL_MPI)
call MatchingC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate)
#else
call MatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate, mrank, mnp, icomm,&
& msgindsent,msgactualsent,msgpercent,&
& ph0_time, ph1_time, ph2_time, ph1_card, ph2_card)
#endif
verlocptr(:) = verlocptr(:) + 1
verlocind(:) = verlocind(:) + 1
verdistance(:) = verdistance(:) + 1
+19 -27
View File
@@ -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
@@ -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
+3 -35
View File
@@ -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
@@ -188,10 +188,8 @@ module amg_s_onelev_mod
procedure, pass(lv) :: clone => s_base_onelev_clone
procedure, pass(lv) :: cnv => amg_s_base_onelev_cnv
procedure, pass(lv) :: descr => amg_s_base_onelev_descr
procedure, pass(lv) :: memory_use => amg_s_base_onelev_memory_use
procedure, pass(lv) :: default => s_base_onelev_default
procedure, pass(lv) :: free => amg_s_base_onelev_free
procedure, pass(lv) :: free_smoothers => amg_s_base_onelev_free_smoothers
procedure, pass(lv) :: nullify => s_base_onelev_nullify
procedure, pass(lv) :: check => amg_s_base_onelev_check
procedure, pass(lv) :: dump => amg_s_base_onelev_dump
@@ -260,7 +258,7 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
@@ -271,27 +269,9 @@ module amg_s_onelev_mod
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
end subroutine amg_s_base_onelev_descr
end interface
interface
subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None
! Arguments
class(amg_s_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
integer(psb_ipk_), intent(in), optional :: verbosity
character(len=*), intent(in), optional :: prefix
logical, intent(in), optional :: global
end subroutine amg_s_base_onelev_memory_use
end interface
interface
subroutine amg_s_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_s_onelev_type, psb_s_base_vect_type, psb_spk_, &
@@ -305,7 +285,7 @@ module amg_s_onelev_mod
end subroutine amg_s_base_onelev_cnv
end interface
interface
interface
subroutine amg_s_base_onelev_free(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
@@ -317,18 +297,6 @@ module amg_s_onelev_mod
end subroutine amg_s_base_onelev_free
end interface
interface
subroutine amg_s_base_onelev_free_smoothers(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none
class(amg_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_base_onelev_free_smoothers
end interface
interface
subroutine amg_s_base_onelev_check(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
+22 -24
View File
@@ -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
@@ -54,7 +54,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,6 +119,10 @@
module amg_s_parmatch_aggregator_mod
use amg_s_base_aggregator_mod
use amg_s_matchboxp_mod
#if defined(SERIAL_MPI)
type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
end type amg_s_parmatch_aggregator_type
#else
type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
integer(psb_ipk_) :: matching_alg
integer(psb_ipk_) :: n_sweeps ! When n_sweeps >1 we need an auxiliary descriptor
@@ -240,12 +244,11 @@ module amg_s_parmatch_aggregator_mod
end interface
interface
subroutine amg_s_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
subroutine amg_s_parmatch_unsmth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
implicit none
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
@@ -259,12 +262,11 @@ module amg_s_parmatch_aggregator_mod
end interface
interface
subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info)
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
implicit none
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
@@ -388,26 +390,18 @@ contains
end function amg_s_parmatch_aggregator_sizeof
subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info)
implicit none
class(amg_s_parmatch_aggregator_type), intent(in) :: ag
type(amg_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_
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)
write(iout,*) 'Parallel Matching Aggregator'
write(iout,*) ' Number of matching sweeps: ',ag%n_sweeps
write(iout,*) ' Matching algorithm : MatchBoxP (PREIS)'
write(iout,*) 'Aggregator object type: ',ag%fmt()
call parms%mldescr(iout,info)
return
end subroutine amg_s_parmatch_aggregator_descr
@@ -448,7 +442,6 @@ contains
class(amg_s_base_aggregator_type), target, intent(inout) :: agnext
integer(psb_ipk_), intent(out) :: info
info = psb_success_
!
!
select type(agnext)
@@ -588,7 +581,7 @@ contains
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
integer(psb_ipk_), intent(out) :: info
info = psb_success_
info = 0
if ((info == 0).and.allocated(ag%w)) deallocate(ag%w,stat=info)
if ((info == 0).and.allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info)
if ((info == 0).and.allocated(ag%prol)) then
@@ -627,7 +620,7 @@ contains
class(amg_s_base_aggregator_type), allocatable, intent(inout) :: agnext
integer(psb_ipk_), intent(out) :: info
info = psb_success_
info = 0
if (allocated(agnext)) then
call agnext%free(info)
if (info == 0) deallocate(agnext,stat=info)
@@ -656,7 +649,6 @@ contains
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_parmatch_aggregator_bld_map'
info = psb_success_
call psb_erractionsave(err_act)
!
! Copy the prolongation/restriction matrices into the descriptor map.
@@ -674,6 +666,11 @@ contains
map = psb_linmap(psb_map_gen_linear_,desc_a,&
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
end if
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999
end if
call psb_erractionrestore(err_act)
return
@@ -681,4 +678,5 @@ contains
return
end subroutine amg_s_parmatch_aggregator_bld_map
#endif
end module amg_s_parmatch_aggregator_mod

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