mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-09 23:49:05 +00:00
Compare commits
99
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
8f259367de | ||
|
|
15d1386b73 | ||
|
|
14d24b1d7c | ||
|
|
92425e2478 | ||
|
|
228f4e46a9 | ||
|
|
492ae602f2 | ||
|
|
3230c70308 | ||
|
|
eb99c74fae | ||
|
|
1c69b2f635 | ||
|
|
86731fe5bb | ||
|
|
7a5ba06622 | ||
|
|
d4c0428704 | ||
|
|
1a969488e3 | ||
|
|
95382fbb01 | ||
|
|
f586df1ac3 | ||
|
|
bab8a27962 | ||
|
|
28ccefa4bb | ||
|
|
3f33b2ce71 | ||
|
|
7279347055 | ||
|
|
e627667f3c | ||
|
|
1557bcc45b | ||
|
|
786abaff97 | ||
|
|
06f8f83114 | ||
|
|
43a75e3171 | ||
|
|
2bde1beda2 | ||
|
|
7d110a88d0 | ||
|
|
f915372c99 | ||
|
|
b5df1842e0 | ||
|
|
a6267d8e67 | ||
|
|
498f8bd482 | ||
|
|
7aef98fc09 | ||
|
|
31a44360a4 | ||
|
|
83a668c1e0 | ||
|
|
c162633845 | ||
|
|
547c4f3a60 | ||
|
|
92766e743a | ||
|
|
212892e84a | ||
|
|
f9c0eec453 | ||
|
|
387d6bef74 | ||
|
|
d6550abc70 | ||
|
|
d95341b45a | ||
|
|
7da64944b5 | ||
|
|
daaa06e486 | ||
|
|
5ee819592f | ||
|
|
5408e16a4a | ||
|
|
372ef708e0 | ||
|
|
f4e1ba97e9 | ||
|
|
e429b04600 | ||
|
|
6c12de02e8 | ||
|
|
0cb2c1c0c6 | ||
|
|
7c153de54a | ||
|
|
00cf38906a | ||
|
|
23cf86a797 | ||
|
|
91bea72cfe | ||
|
|
9a36a321f2 | ||
|
|
60d722ec53 | ||
|
|
1b8aa1618e | ||
|
|
154e88cd69 | ||
|
|
cf93042e42 | ||
|
|
ecaea5b794 | ||
|
|
3a42a2597c | ||
|
|
fcf48ee614 | ||
|
|
0ddd35b7b6 | ||
|
|
4c19edb2f9 | ||
|
|
c7c02bf7c0 | ||
|
|
7050095ca5 | ||
|
|
b7edff0848 | ||
|
|
6214a918f1 | ||
|
|
b724a324c9 | ||
|
|
21b85bc533 | ||
|
|
3176a53a61 | ||
|
|
b246223597 | ||
|
|
2f4c9dd579 | ||
|
|
657986c938 | ||
|
|
687e0824e8 | ||
|
|
7abeb7d192 | ||
|
|
196cedfedb | ||
|
|
120da08860 | ||
|
|
70b28ddc08 | ||
|
|
22b37fa6d3 | ||
|
|
8fdff8e33b | ||
|
|
0d07a81aa7 | ||
|
|
64d2ead7a0 | ||
|
|
e762554627 | ||
|
|
b5e7d6aaaa | ||
|
|
886e03ab65 | ||
|
|
a0fc174c84 | ||
|
|
bbf5cc9826 | ||
|
|
8337edb362 | ||
|
|
a39cd229e0 | ||
|
|
a983f95fc2 | ||
|
|
5748358fe9 | ||
|
|
20b3c30e24 | ||
|
|
d61c9fed9f | ||
|
|
a8cf53d80e | ||
|
|
2efe639a19 | ||
|
|
b426a9ccf7 | ||
|
|
1feaf40972 | ||
|
|
cc66413be8 |
+542
@@ -0,0 +1,542 @@
|
||||
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()
|
||||
|
||||
|
||||
|
||||
#------------------------------------------
|
||||
# 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};")
|
||||
|
||||
@@ -1,10 +1,11 @@
|
||||
include Make.inc
|
||||
|
||||
|
||||
all: objs lib
|
||||
|
||||
objs: libdir amgp cbnd
|
||||
all: mods objs lib
|
||||
|
||||
objs: libdir mods amgobjs cbnd
|
||||
mods: libdir
|
||||
cd amgprec && $(MAKE) mods
|
||||
lib: objs
|
||||
cd amgprec && $(MAKE) lib
|
||||
cd cbind && $(MAKE) lib
|
||||
@@ -15,13 +16,13 @@ libdir:
|
||||
(if test ! -d modules ; then mkdir modules; fi;)
|
||||
($(INSTALL_DATA) Make.inc include/Make.inc.amg4psblas)
|
||||
|
||||
|
||||
amgp:
|
||||
amgobjs: mods
|
||||
cd amgprec && $(MAKE) objs
|
||||
cbnd: amgp
|
||||
|
||||
cbnd: mods
|
||||
cd cbind && $(MAKE) objs
|
||||
|
||||
install: lib
|
||||
install: all
|
||||
mkdir -p $(INSTALL_LIBDIR) &&\
|
||||
$(INSTALL_DATA) lib/*.a $(INSTALL_LIBDIR)
|
||||
mkdir -p $(INSTALL_INCLUDEDIR) &&\
|
||||
|
||||
@@ -1,19 +1,36 @@
|
||||
# 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 is a package of parallel algebraic multilevel preconditioners included in
|
||||
the PSCToolkit (Parallel Sparse Computation Toolkit) software framework.
|
||||
|
||||
It is a progress of a software development project started in 2007, named MLD2P4, 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.
|
||||
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 years the package was extended for including new algorithms and functionalities for the setup and application new AMG preconditioners with the final aims of improving efficiency and scalability when tens of thousands cores are used and of boosting reliability in dealing with general symmetric positive definite linear systems.
|
||||
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.
|
||||
|
||||
It is an evolution of MLD2P4 (see [LICENSE.MLD2P4](LICENSE.MLD2P4)), but due to the significant number of changes and the increase in scope, we decided to rename the package as AMG4PSBLAS.
|
||||
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.
|
||||
|
||||
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 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.
|
||||
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.
|
||||
|
||||
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.
|
||||
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:
|
||||
|
||||
@@ -32,20 +49,23 @@ The main reference for features inherited from MLD2P4 is
|
||||
|
||||
## Installing
|
||||
|
||||
Installation requires having a working version of the [PSBLAS](https://github.com/sfilippone/psblas3) library installed.
|
||||
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. This is _not mandatory_ and the library can run
|
||||
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.
|
||||
|
||||
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>`
|
||||
1. run configure `--with-psblas=<ABSOLUTE path of the PSBLAS install directory> --prefix=<install_path>`
|
||||
adding the options for MUMPS, SuperLU, SuperLU_Dist, UMFPACK as desired.
|
||||
See [AMG4PSBLAS User's and Reference Guide](docs/amg4psblas_1.0-guide.pdf) (Section 3) for details.
|
||||
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`;
|
||||
4. Go into the test subdirectory and build the examples of your choice.
|
||||
5. (if desired): `make install`
|
||||
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;
|
||||
@@ -53,13 +73,77 @@ in isolation and without these features.
|
||||
>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
|
||||
```
|
||||
|
||||
|
||||
### CUDA, OpeMP, OpenACC
|
||||
|
||||
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. If these 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.
|
||||
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.
|
||||
|
||||
### EoCoE - Software as service portal
|
||||
|
||||
In the European project “Energy oriented Center of Excellence: toward exascale for energy” we made available a software as service portal: [https://eocoe.psnc.pl/](https://eocoe.psnc.pl/). This permits to test several cutting-edge computational methods for accelerating the transition to the 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.
|
||||
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
|
||||
|
||||
@@ -74,3 +158,9 @@ In the European project “Energy oriented Center of Excellence: toward exascale
|
||||
- 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
|
||||
|
||||
@@ -0,0 +1,907 @@
|
||||
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()
|
||||
+9
-10
@@ -58,23 +58,22 @@ 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))
|
||||
LOCAL_MODS=$(MODOBJS:.o=$(.mod)) amg_c_l1_diag_solver$(.mod) amg_s_l1_diag_solver$(.mod) \
|
||||
amg_d_l1_diag_solver$(.mod) amg_z_l1_diag_solver$(.mod)
|
||||
LIBNAME=libamg_prec.a
|
||||
|
||||
all: objs impld
|
||||
all: mods objs impld
|
||||
|
||||
objs: $(OBJS)
|
||||
mods: $(MODOBJS)
|
||||
/bin/cp -p amg_const.h amg_config.h $(INCDIR)
|
||||
/bin/cp -p *$(.mod) $(MODDIR)
|
||||
|
||||
impld: objs
|
||||
objs: mods impld
|
||||
impld: mods
|
||||
cd impl && $(MAKE)
|
||||
|
||||
lib: $(OBJS) impld
|
||||
lib: objs
|
||||
cd impl && $(MAKE) lib
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(AR) $(HERE)/$(LIBNAME) $(MODOBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
|
||||
|
||||
@@ -221,7 +220,7 @@ veryclean: clean
|
||||
/bin/rm -f $(LIBNAME)
|
||||
|
||||
clean: implclean
|
||||
/bin/rm -f $(OBJS) $(LOCAL_MODS) *$(.mod)
|
||||
/bin/rm -f $(MODOBJS) $(LOCAL_MODS) *$(.mod)
|
||||
|
||||
implclean:
|
||||
cd impl && $(MAKE) clean
|
||||
|
||||
@@ -621,9 +621,13 @@ contains
|
||||
|
||||
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(val), ' to ',amg_get_coarse_mat_name(expected)
|
||||
& amg_get_coarse_mat_name(mval), &
|
||||
& ' to ',amg_get_coarse_mat_name(mexp)
|
||||
end if
|
||||
end subroutine amg_warn_coarse_mat
|
||||
|
||||
@@ -1207,7 +1211,7 @@ contains
|
||||
implicit none
|
||||
type(psb_ctxt_type), intent(in) :: ctxt
|
||||
type(amg_ml_parms), intent(inout) :: dat
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_mpk_), intent(in), optional :: root
|
||||
|
||||
call psb_bcast(ctxt,dat%sweeps_pre,root)
|
||||
call psb_bcast(ctxt,dat%sweeps_post,root)
|
||||
@@ -1229,7 +1233,7 @@ contains
|
||||
implicit none
|
||||
type(psb_ctxt_type), intent(in) :: ctxt
|
||||
type(amg_sml_parms), intent(inout) :: dat
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_mpk_), intent(in), optional :: root
|
||||
|
||||
call psb_bcast(ctxt,dat%amg_ml_parms,root)
|
||||
call psb_bcast(ctxt,dat%aggr_omega_val,root)
|
||||
@@ -1240,7 +1244,7 @@ contains
|
||||
implicit none
|
||||
type(psb_ctxt_type), intent(in) :: ctxt
|
||||
type(amg_dml_parms), intent(inout) :: dat
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_mpk_), intent(in), optional :: root
|
||||
|
||||
call psb_bcast(ctxt,dat%amg_ml_parms,root)
|
||||
call psb_bcast(ctxt,dat%aggr_omega_val,root)
|
||||
|
||||
+261
-205
@@ -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 => 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) :: 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) :: free => c_slu_solver_free
|
||||
procedure, pass(sv) :: clear_data => c_slu_solver_clear_data
|
||||
procedure, pass(sv) :: descr => c_slu_solver_descr
|
||||
@@ -76,9 +76,8 @@ module amg_c_slu_solver
|
||||
end type amg_c_slu_solver_type
|
||||
|
||||
|
||||
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, &
|
||||
private :: c_slu_solver_free, c_slu_solver_descr, &
|
||||
& c_slu_solver_sizeof, &
|
||||
& c_slu_solver_get_fmt, c_slu_solver_get_id, &
|
||||
& c_slu_solver_clear_data
|
||||
private :: c_slu_solver_finalize
|
||||
@@ -118,207 +117,264 @@ 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)
|
||||
|
||||
|
||||
@@ -161,7 +161,7 @@ contains
|
||||
logical, parameter :: dump=.false., debug=.false., dump_mate=.false., &
|
||||
& debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
|
||||
integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
|
||||
|
||||
ictxt = desc_a%get_ctxt()
|
||||
@@ -624,7 +624,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=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
ictxt = desc_a%get_ctxt()
|
||||
call psb_info(ictxt,iam,np)
|
||||
@@ -826,7 +826,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=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
logical, parameter :: debug_symmetry = .false., check_size=.false.
|
||||
logical, parameter :: unroll_logtrans=.false.
|
||||
|
||||
@@ -879,7 +879,7 @@ contains
|
||||
nr = tcoo1%get_nrows()
|
||||
nc = tcoo1%get_ncols()
|
||||
nz = tcoo1%get_nzeros()
|
||||
call tcoo2%allocate(nr,nc,int(1.25*nz))
|
||||
call tcoo2%allocate(nr,nc,int(1.25*nz,psb_ipk_))
|
||||
k2 = 0
|
||||
!
|
||||
! Build the entries of \^A for matching
|
||||
@@ -1056,7 +1056,8 @@ contains
|
||||
integer(psb_c_lpk_) :: ph1_card(*),ph2_card(*)
|
||||
real(c_double) :: edgelocweight(:)
|
||||
real(c_double) :: msgpercent(*)
|
||||
integer(psb_ipk_) :: info, me, np
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_mpk_) :: me, np
|
||||
integer(psb_c_mpk_) :: icomm, mrank, mnp
|
||||
logical, optional :: display_inp
|
||||
!
|
||||
|
||||
+261
-205
@@ -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 => 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) :: 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) :: free => d_slu_solver_free
|
||||
procedure, pass(sv) :: clear_data => d_slu_solver_clear_data
|
||||
procedure, pass(sv) :: descr => d_slu_solver_descr
|
||||
@@ -76,9 +76,8 @@ module amg_d_slu_solver
|
||||
end type amg_d_slu_solver_type
|
||||
|
||||
|
||||
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, &
|
||||
private :: d_slu_solver_free, d_slu_solver_descr, &
|
||||
& d_slu_solver_sizeof, &
|
||||
& d_slu_solver_get_fmt, d_slu_solver_get_id, &
|
||||
& d_slu_solver_clear_data
|
||||
private :: d_slu_solver_finalize
|
||||
@@ -118,207 +117,264 @@ 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)
|
||||
|
||||
|
||||
+62
-206
@@ -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 => 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) :: 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) :: free => d_umf_solver_free
|
||||
procedure, pass(sv) :: clear_data => d_umf_solver_clear_data
|
||||
procedure, pass(sv) :: descr => d_umf_solver_descr
|
||||
@@ -75,9 +75,8 @@ module amg_d_umf_solver
|
||||
end type amg_d_umf_solver_type
|
||||
|
||||
|
||||
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, &
|
||||
private :: d_umf_solver_free, d_umf_solver_descr, &
|
||||
& d_umf_solver_sizeof, &
|
||||
& d_umf_solver_get_fmt, d_umf_solver_get_id, &
|
||||
& d_umf_solver_clear_data
|
||||
private :: d_umf_solver_finalize
|
||||
@@ -118,208 +117,65 @@ 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)
|
||||
|
||||
|
||||
@@ -161,7 +161,7 @@ contains
|
||||
logical, parameter :: dump=.false., debug=.false., dump_mate=.false., &
|
||||
& debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
|
||||
integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
|
||||
|
||||
ictxt = desc_a%get_ctxt()
|
||||
@@ -624,7 +624,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=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
ictxt = desc_a%get_ctxt()
|
||||
call psb_info(ictxt,iam,np)
|
||||
@@ -826,7 +826,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=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
logical, parameter :: debug_symmetry = .false., check_size=.false.
|
||||
logical, parameter :: unroll_logtrans=.false.
|
||||
|
||||
@@ -879,7 +879,7 @@ contains
|
||||
nr = tcoo1%get_nrows()
|
||||
nc = tcoo1%get_ncols()
|
||||
nz = tcoo1%get_nzeros()
|
||||
call tcoo2%allocate(nr,nc,int(1.25*nz))
|
||||
call tcoo2%allocate(nr,nc,int(1.25*nz,psb_ipk_))
|
||||
k2 = 0
|
||||
!
|
||||
! Build the entries of \^A for matching
|
||||
@@ -1056,7 +1056,8 @@ contains
|
||||
integer(psb_c_lpk_) :: ph1_card(*),ph2_card(*)
|
||||
real(c_float) :: edgelocweight(:)
|
||||
real(c_double) :: msgpercent(*)
|
||||
integer(psb_ipk_) :: info, me, np
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_mpk_) :: me, np
|
||||
integer(psb_c_mpk_) :: icomm, mrank, mnp
|
||||
logical, optional :: display_inp
|
||||
!
|
||||
|
||||
+261
-205
@@ -63,9 +63,9 @@ module amg_s_slu_solver
|
||||
type(c_ptr) :: lufactors=c_null_ptr
|
||||
integer(c_long_long) :: symbsize=0, numsize=0
|
||||
contains
|
||||
procedure, pass(sv) :: build => s_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => s_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => s_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: build => amg_s_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => amg_s_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => amg_s_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: free => s_slu_solver_free
|
||||
procedure, pass(sv) :: clear_data => s_slu_solver_clear_data
|
||||
procedure, pass(sv) :: descr => s_slu_solver_descr
|
||||
@@ -76,9 +76,8 @@ module amg_s_slu_solver
|
||||
end type amg_s_slu_solver_type
|
||||
|
||||
|
||||
private :: s_slu_solver_bld, s_slu_solver_apply, &
|
||||
& s_slu_solver_free, s_slu_solver_descr, &
|
||||
& s_slu_solver_sizeof, s_slu_solver_apply_vect, &
|
||||
private :: s_slu_solver_free, s_slu_solver_descr, &
|
||||
& s_slu_solver_sizeof, &
|
||||
& s_slu_solver_get_fmt, s_slu_solver_get_id, &
|
||||
& s_slu_solver_clear_data
|
||||
private :: s_slu_solver_finalize
|
||||
@@ -118,207 +117,264 @@ module amg_s_slu_solver
|
||||
end function amg_sslu_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
import amg_s_slu_solver_type
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
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_slu_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_s_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_slu_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_slu_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_s_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_slu_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_slu_solver_apply
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine s_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_s_slu_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, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_spk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
real(psb_spk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='s_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_spk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
ww(1:n_row) = x(1:n_row)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_sslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('T')
|
||||
info = amg_sslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('C')
|
||||
info = amg_sslu_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 s_slu_solver_apply
|
||||
|
||||
subroutine s_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_s_slu_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, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_s_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='s_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 s_slu_solver_apply_vect
|
||||
|
||||
subroutine s_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
integer, 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
|
||||
! Local variables
|
||||
type(psb_sspmat_type) :: atmp
|
||||
type(psb_s_csc_sparse_mat) :: acsc
|
||||
type(psb_s_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='s_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_sslu_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_sslu_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 s_slu_solver_bld
|
||||
!!$ subroutine s_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_s_slu_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, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ real(psb_spk_),intent(inout), optional :: initu(:)
|
||||
!!$
|
||||
!!$ integer :: n_row,n_col
|
||||
!!$ real(psb_spk_), pointer :: ww(:)
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act
|
||||
!!$ character :: trans_
|
||||
!!$ character(len=20) :: name='s_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_spk_)')
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ ww(1:n_row) = x(1:n_row)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ info = amg_sslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('T')
|
||||
!!$ info = amg_sslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('C')
|
||||
!!$ info = amg_sslu_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 s_slu_solver_apply
|
||||
!!$
|
||||
!!$ subroutine s_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_s_slu_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, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ type(psb_s_vect_type),intent(inout), optional :: initu
|
||||
!!$
|
||||
!!$ integer :: err_act
|
||||
!!$ character(len=20) :: name='s_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 s_slu_solver_apply_vect
|
||||
!!$
|
||||
!!$ subroutine s_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
!!$
|
||||
!!$ use psb_base_mod
|
||||
!!$
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ type(psb_sspmat_type), intent(in), target :: a
|
||||
!!$ Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
!!$ class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
!!$ integer, 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
|
||||
!!$ ! Local variables
|
||||
!!$ type(psb_sspmat_type) :: atmp
|
||||
!!$ type(psb_s_csc_sparse_mat) :: acsc
|
||||
!!$ type(psb_s_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='s_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_sslu_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_sslu_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 s_slu_solver_bld
|
||||
|
||||
subroutine s_slu_solver_free(sv,info)
|
||||
|
||||
|
||||
+261
-205
@@ -63,9 +63,9 @@ module amg_z_slu_solver
|
||||
type(c_ptr) :: lufactors=c_null_ptr
|
||||
integer(c_long_long) :: symbsize=0, numsize=0
|
||||
contains
|
||||
procedure, pass(sv) :: build => z_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => z_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => z_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: build => amg_z_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => amg_z_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => amg_z_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: free => z_slu_solver_free
|
||||
procedure, pass(sv) :: clear_data => z_slu_solver_clear_data
|
||||
procedure, pass(sv) :: descr => z_slu_solver_descr
|
||||
@@ -76,9 +76,8 @@ module amg_z_slu_solver
|
||||
end type amg_z_slu_solver_type
|
||||
|
||||
|
||||
private :: z_slu_solver_bld, z_slu_solver_apply, &
|
||||
& z_slu_solver_free, z_slu_solver_descr, &
|
||||
& z_slu_solver_sizeof, z_slu_solver_apply_vect, &
|
||||
private :: z_slu_solver_free, z_slu_solver_descr, &
|
||||
& z_slu_solver_sizeof, &
|
||||
& z_slu_solver_get_fmt, z_slu_solver_get_id, &
|
||||
& z_slu_solver_clear_data
|
||||
private :: z_slu_solver_finalize
|
||||
@@ -118,207 +117,264 @@ module amg_z_slu_solver
|
||||
end function amg_zslu_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
import amg_z_slu_solver_type
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_zspmat_type), intent(in), target, optional :: b
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_z_slu_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_z_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_z_vect_type),intent(inout) :: x
|
||||
type(psb_z_vect_type),intent(inout) :: y
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_z_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_z_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_z_slu_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_z_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
complex(psb_dpk_),intent(inout) :: x(:)
|
||||
complex(psb_dpk_),intent(inout) :: y(:)
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_z_slu_solver_apply
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine z_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_z_slu_solver_type), intent(inout) :: sv
|
||||
complex(psb_dpk_),intent(inout) :: x(:)
|
||||
complex(psb_dpk_),intent(inout) :: y(:)
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
complex(psb_dpk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='z_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_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
ww(1:n_row) = x(1:n_row)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_zslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('T')
|
||||
info = amg_zslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('C')
|
||||
info = amg_zslu_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 z_slu_solver_apply
|
||||
|
||||
subroutine z_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_z_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_z_vect_type),intent(inout) :: x
|
||||
type(psb_z_vect_type),intent(inout) :: y
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_z_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_z_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='z_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 z_slu_solver_apply_vect
|
||||
|
||||
subroutine z_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
type(psb_zspmat_type), intent(in), target, optional :: b
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_zspmat_type) :: atmp
|
||||
type(psb_z_csc_sparse_mat) :: acsc
|
||||
type(psb_z_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='z_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_zslu_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_zslu_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 z_slu_solver_bld
|
||||
!!$ subroutine z_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_z_slu_solver_type), intent(inout) :: sv
|
||||
!!$ complex(psb_dpk_),intent(inout) :: x(:)
|
||||
!!$ complex(psb_dpk_),intent(inout) :: y(:)
|
||||
!!$ complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ complex(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
!!$
|
||||
!!$ integer :: n_row,n_col
|
||||
!!$ complex(psb_dpk_), pointer :: ww(:)
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act
|
||||
!!$ character :: trans_
|
||||
!!$ character(len=20) :: name='z_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_dpk_)')
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ ww(1:n_row) = x(1:n_row)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ info = amg_zslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('T')
|
||||
!!$ info = amg_zslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('C')
|
||||
!!$ info = amg_zslu_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 z_slu_solver_apply
|
||||
!!$
|
||||
!!$ subroutine z_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_z_slu_solver_type), intent(inout) :: sv
|
||||
!!$ type(psb_z_vect_type),intent(inout) :: x
|
||||
!!$ type(psb_z_vect_type),intent(inout) :: y
|
||||
!!$ complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
!!$ type(psb_z_vect_type),intent(inout) :: wv(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ type(psb_z_vect_type),intent(inout), optional :: initu
|
||||
!!$
|
||||
!!$ integer :: err_act
|
||||
!!$ character(len=20) :: name='z_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 z_slu_solver_apply_vect
|
||||
!!$
|
||||
!!$ subroutine z_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
!!$
|
||||
!!$ use psb_base_mod
|
||||
!!$
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ type(psb_zspmat_type), intent(in), target :: a
|
||||
!!$ Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
!!$ class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ type(psb_zspmat_type), intent(in), target, optional :: b
|
||||
!!$ class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
!!$ class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
!!$ class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
!!$ ! Local variables
|
||||
!!$ type(psb_zspmat_type) :: atmp
|
||||
!!$ type(psb_z_csc_sparse_mat) :: acsc
|
||||
!!$ type(psb_z_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='z_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_zslu_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_zslu_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 z_slu_solver_bld
|
||||
|
||||
subroutine z_slu_solver_free(sv,info)
|
||||
|
||||
|
||||
+62
-206
@@ -62,9 +62,9 @@ module amg_z_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 => z_umf_solver_bld
|
||||
procedure, pass(sv) :: apply_a => z_umf_solver_apply
|
||||
procedure, pass(sv) :: apply_v => z_umf_solver_apply_vect
|
||||
procedure, pass(sv) :: build => amg_z_umf_solver_bld
|
||||
procedure, pass(sv) :: apply_a => amg_z_umf_solver_apply
|
||||
procedure, pass(sv) :: apply_v => amg_z_umf_solver_apply_vect
|
||||
procedure, pass(sv) :: free => z_umf_solver_free
|
||||
procedure, pass(sv) :: clear_data => z_umf_solver_clear_data
|
||||
procedure, pass(sv) :: descr => z_umf_solver_descr
|
||||
@@ -75,9 +75,8 @@ module amg_z_umf_solver
|
||||
end type amg_z_umf_solver_type
|
||||
|
||||
|
||||
private :: z_umf_solver_bld, z_umf_solver_apply, &
|
||||
& z_umf_solver_free, z_umf_solver_descr, &
|
||||
& z_umf_solver_sizeof, z_umf_solver_apply_vect, &
|
||||
private :: z_umf_solver_free, z_umf_solver_descr, &
|
||||
& z_umf_solver_sizeof, &
|
||||
& z_umf_solver_get_fmt, z_umf_solver_get_id, &
|
||||
& z_umf_solver_clear_data
|
||||
private :: z_umf_solver_finalize
|
||||
@@ -118,208 +117,65 @@ module amg_z_umf_solver
|
||||
end function amg_zumf_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_z_umf_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
complex(psb_dpk_),intent(inout) :: x(:)
|
||||
complex(psb_dpk_),intent(inout) :: y(:)
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_z_umf_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_z_umf_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
type(psb_z_vect_type),intent(inout) :: x
|
||||
type(psb_z_vect_type),intent(inout) :: y
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_z_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_z_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_z_umf_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
import amg_z_umf_solver_type
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_zspmat_type), intent(in), target, optional :: b
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_z_umf_solver_bld
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine z_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_z_umf_solver_type), intent(inout) :: sv
|
||||
complex(psb_dpk_),intent(inout) :: x(:)
|
||||
complex(psb_dpk_),intent(inout) :: y(:)
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
complex(psb_dpk_), pointer :: ww(:)
|
||||
integer(psb_ipk_) :: i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='z_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='complex(psb_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_zumf_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_z_is_complex_) then
|
||||
info = amg_zumf_solve(2,n_row,ww,x,n_row,sv%numeric)
|
||||
else
|
||||
info = amg_zumf_solve(1,n_row,ww,x,n_row,sv%numeric)
|
||||
end if
|
||||
case('C')
|
||||
info = amg_zumf_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 z_umf_solver_apply
|
||||
|
||||
subroutine z_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_z_umf_solver_type), intent(inout) :: sv
|
||||
type(psb_z_vect_type),intent(inout) :: x
|
||||
type(psb_z_vect_type),intent(inout) :: y
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_z_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_z_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='z_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 z_umf_solver_apply_vect
|
||||
|
||||
subroutine z_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
type(psb_zspmat_type), intent(in), target, optional :: b
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_zspmat_type) :: atmp
|
||||
type(psb_z_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='z_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_zumf_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_zumf_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 z_umf_solver_bld
|
||||
|
||||
subroutine z_umf_solver_free(sv,info)
|
||||
|
||||
|
||||
@@ -488,7 +488,7 @@ subroutine amg_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
|
||||
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nrl, nzl, ip, &
|
||||
& nzt, naggrm1, naggrp1, i, k
|
||||
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
|
||||
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
|
||||
logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
|
||||
integer(psb_ipk_), save :: idx_spspmm=-1
|
||||
|
||||
name='amg_ptap_bld'
|
||||
|
||||
@@ -103,7 +103,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
character(len=20) :: name, ch_err
|
||||
integer(psb_ipk_), save :: idx_soc1_p1=-1, idx_soc1_p2=-1, idx_soc1_p3=-1
|
||||
integer(psb_ipk_), save :: idx_soc1_p0=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_soc1_map_bld'
|
||||
|
||||
@@ -104,7 +104,7 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
character(len=20) :: name, ch_err
|
||||
integer(psb_ipk_), save :: idx_soc2_p1=-1, idx_soc2_p2=-1, idx_soc2_p3=-1
|
||||
integer(psb_ipk_), save :: idx_soc2_p0=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_soc2_map_bld'
|
||||
|
||||
@@ -80,7 +80,7 @@ subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
& a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod
|
||||
use amg_c_prec_type
|
||||
use amg_c_symdec_aggregator_mod, amg_protect_name => amg_c_symdec_aggregator_build_tprol
|
||||
use amg_c_symdec_aggregator_mod, only : amg_c_symdec_aggregator_type
|
||||
use amg_c_inner_mod
|
||||
implicit none
|
||||
class(amg_c_symdec_aggregator_type), target, intent(inout) :: ag
|
||||
@@ -103,6 +103,16 @@ subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
logical :: clean_zeros
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine psb_caplusat(ain,aout,info)
|
||||
!!$ use psb_c_mat_mod, only : psb_cspmat_type
|
||||
!!$ import :: psb_ipk_
|
||||
!!$ implicit none
|
||||
!!$ type(psb_cspmat_type) :: ain, aout
|
||||
!!$ integer(psb_ipk_) :: info
|
||||
!!$ end subroutine psb_caplusat
|
||||
!!$ end interface
|
||||
!!$
|
||||
name='amg_c_symdec_aggregator_tprol'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
@@ -123,15 +133,11 @@ subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
|
||||
|
||||
nr = a%get_nrows()
|
||||
call a%csclip(atmp,info,imax=nr,jmax=nr,&
|
||||
call a%csclip(atrans,info,imax=nr,jmax=nr,&
|
||||
& rscale=.false.,cscale=.false.)
|
||||
call atmp%set_nrows(nr)
|
||||
call atmp%set_ncols(nr)
|
||||
if (info == psb_success_) call atmp%transp(atrans)
|
||||
if (info == psb_success_) call atrans%cscnv(info,type='COO')
|
||||
if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.)
|
||||
call atmp%set_nrows(nr)
|
||||
call atmp%set_ncols(nr)
|
||||
call atrans%set_nrows(nr)
|
||||
call atrans%set_ncols(nr)
|
||||
call psb_aplusat(atrans,atmp,info)
|
||||
if (info == psb_success_) call atrans%free()
|
||||
if (info == psb_success_) call atmp%cscnv(info,type='CSR')
|
||||
|
||||
|
||||
@@ -108,7 +108,7 @@ subroutine amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!
|
||||
type(psb_ctxt_type) :: ictxt
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np, me
|
||||
type(psb_ld_coo_sparse_mat) :: tmpcoo
|
||||
type(psb_ldspmat_type) :: tmp_ac
|
||||
@@ -124,8 +124,8 @@ subroutine amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
info = psb_success_
|
||||
ictxt = desc_a%get_context()
|
||||
call psb_info(ictxt,me,np)
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt,me,np)
|
||||
if (psb_get_errstatus().ne.0) then
|
||||
write(0,*) me,' From:',trim(name),':',psb_get_errstatus()
|
||||
return
|
||||
@@ -163,22 +163,21 @@ subroutine amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
|
||||
call op_prol%mv_to(tmpcoo)
|
||||
nzl = tmpcoo%get_nzeros()
|
||||
call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
|
||||
call tmpcoo%set_ncols(i_nr)
|
||||
call op_prol%mv_from(tmpcoo)
|
||||
|
||||
call op_restr%mv_to(tmpcoo)
|
||||
nzl = tmpcoo%get_nzeros()
|
||||
call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
|
||||
call tmpcoo%set_nrows(i_nr)
|
||||
call op_restr%mv_from(tmpcoo)
|
||||
|
||||
call op_prol%set_ncols(i_nr)
|
||||
call op_restr%set_nrows(i_nr)
|
||||
|
||||
call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
|
||||
& dupl=psb_dupl_add_,keeploc=.false.)
|
||||
call tmp_ac%mv_to(tmpcoo)
|
||||
call ac%mv_from(tmpcoo)
|
||||
|
||||
call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.)
|
||||
call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
|
||||
if (info == psb_success_) call psb_cdasb(desc_ac,info)
|
||||
!
|
||||
! Now that we have the descriptors and the restrictor, we should
|
||||
|
||||
@@ -84,7 +84,7 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
type(psb_ldspmat_type) :: tmp_prol, tmp_pg, tmp_restr
|
||||
type(psb_desc_type) :: tmp_desc_ac, tmp_desc_ax, tmp_desc_p
|
||||
integer(psb_ipk_), save :: idx_mboxp=-1, idx_spmmbld=-1, idx_sweeps_mult=-1
|
||||
logical, parameter :: dump=.false., do_timings=.true., debug=.false., &
|
||||
logical, parameter :: dump=.false., do_timings=.false., debug=.false., &
|
||||
& dump_prol_restr=.false.
|
||||
|
||||
name='d_parmatch_tprol'
|
||||
|
||||
@@ -127,7 +127,7 @@ subroutine amg_d_parmatch_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,&
|
||||
& nzt, naggrm1, naggrp1, i, k
|
||||
integer(psb_lpk_), allocatable :: ia(:),ja(:)
|
||||
!integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave
|
||||
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
|
||||
logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
|
||||
integer(psb_ipk_), save :: idx_spspmm=-1, idx_prolcnv=-1, idx_proltrans=-1, idx_asb=-1
|
||||
|
||||
name='amg_parmatch_spmm_bld_inner'
|
||||
|
||||
@@ -488,7 +488,7 @@ subroutine amg_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
|
||||
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nrl, nzl, ip, &
|
||||
& nzt, naggrm1, naggrp1, i, k
|
||||
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
|
||||
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
|
||||
logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
|
||||
integer(psb_ipk_), save :: idx_spspmm=-1
|
||||
|
||||
name='amg_ptap_bld'
|
||||
|
||||
@@ -103,7 +103,7 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
character(len=20) :: name, ch_err
|
||||
integer(psb_ipk_), save :: idx_soc1_p1=-1, idx_soc1_p2=-1, idx_soc1_p3=-1
|
||||
integer(psb_ipk_), save :: idx_soc1_p0=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_soc1_map_bld'
|
||||
|
||||
@@ -104,7 +104,7 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
character(len=20) :: name, ch_err
|
||||
integer(psb_ipk_), save :: idx_soc2_p1=-1, idx_soc2_p2=-1, idx_soc2_p3=-1
|
||||
integer(psb_ipk_), save :: idx_soc2_p0=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_soc2_map_bld'
|
||||
|
||||
@@ -80,7 +80,7 @@ subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
& a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod
|
||||
use amg_d_prec_type
|
||||
use amg_d_symdec_aggregator_mod, amg_protect_name => amg_d_symdec_aggregator_build_tprol
|
||||
use amg_d_symdec_aggregator_mod, only : amg_d_symdec_aggregator_type
|
||||
use amg_d_inner_mod
|
||||
implicit none
|
||||
class(amg_d_symdec_aggregator_type), target, intent(inout) :: ag
|
||||
@@ -103,6 +103,16 @@ subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
logical :: clean_zeros
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine psb_daplusat(ain,aout,info)
|
||||
!!$ use psb_d_mat_mod, only : psb_dspmat_type
|
||||
!!$ import :: psb_ipk_
|
||||
!!$ implicit none
|
||||
!!$ type(psb_dspmat_type) :: ain, aout
|
||||
!!$ integer(psb_ipk_) :: info
|
||||
!!$ end subroutine psb_daplusat
|
||||
!!$ end interface
|
||||
!!$
|
||||
name='amg_d_symdec_aggregator_tprol'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
@@ -123,15 +133,11 @@ subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
|
||||
|
||||
nr = a%get_nrows()
|
||||
call a%csclip(atmp,info,imax=nr,jmax=nr,&
|
||||
call a%csclip(atrans,info,imax=nr,jmax=nr,&
|
||||
& rscale=.false.,cscale=.false.)
|
||||
call atmp%set_nrows(nr)
|
||||
call atmp%set_ncols(nr)
|
||||
if (info == psb_success_) call atmp%transp(atrans)
|
||||
if (info == psb_success_) call atrans%cscnv(info,type='COO')
|
||||
if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.)
|
||||
call atmp%set_nrows(nr)
|
||||
call atmp%set_ncols(nr)
|
||||
call atrans%set_nrows(nr)
|
||||
call atrans%set_ncols(nr)
|
||||
call psb_aplusat(atrans,atmp,info)
|
||||
if (info == psb_success_) call atrans%free()
|
||||
if (info == psb_success_) call atmp%cscnv(info,type='CSR')
|
||||
|
||||
|
||||
@@ -108,7 +108,7 @@ subroutine amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!
|
||||
type(psb_ctxt_type) :: ictxt
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np, me
|
||||
type(psb_ls_coo_sparse_mat) :: tmpcoo
|
||||
type(psb_lsspmat_type) :: tmp_ac
|
||||
@@ -124,8 +124,8 @@ subroutine amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
info = psb_success_
|
||||
ictxt = desc_a%get_context()
|
||||
call psb_info(ictxt,me,np)
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt,me,np)
|
||||
if (psb_get_errstatus().ne.0) then
|
||||
write(0,*) me,' From:',trim(name),':',psb_get_errstatus()
|
||||
return
|
||||
@@ -163,22 +163,21 @@ subroutine amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
|
||||
call op_prol%mv_to(tmpcoo)
|
||||
nzl = tmpcoo%get_nzeros()
|
||||
call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I')
|
||||
call tmpcoo%set_ncols(i_nr)
|
||||
call op_prol%mv_from(tmpcoo)
|
||||
|
||||
call op_restr%mv_to(tmpcoo)
|
||||
nzl = tmpcoo%get_nzeros()
|
||||
call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I')
|
||||
call tmpcoo%set_nrows(i_nr)
|
||||
call op_restr%mv_from(tmpcoo)
|
||||
|
||||
call op_prol%set_ncols(i_nr)
|
||||
call op_restr%set_nrows(i_nr)
|
||||
|
||||
call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,&
|
||||
& dupl=psb_dupl_add_,keeploc=.false.)
|
||||
call tmp_ac%mv_to(tmpcoo)
|
||||
call ac%mv_from(tmpcoo)
|
||||
|
||||
call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.)
|
||||
call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
|
||||
if (info == psb_success_) call psb_cdasb(desc_ac,info)
|
||||
!
|
||||
! Now that we have the descriptors and the restrictor, we should
|
||||
|
||||
@@ -84,7 +84,7 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
type(psb_lsspmat_type) :: tmp_prol, tmp_pg, tmp_restr
|
||||
type(psb_desc_type) :: tmp_desc_ac, tmp_desc_ax, tmp_desc_p
|
||||
integer(psb_ipk_), save :: idx_mboxp=-1, idx_spmmbld=-1, idx_sweeps_mult=-1
|
||||
logical, parameter :: dump=.false., do_timings=.true., debug=.false., &
|
||||
logical, parameter :: dump=.false., do_timings=.false., debug=.false., &
|
||||
& dump_prol_restr=.false.
|
||||
|
||||
name='s_parmatch_tprol'
|
||||
|
||||
@@ -127,7 +127,7 @@ subroutine amg_s_parmatch_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,&
|
||||
& nzt, naggrm1, naggrp1, i, k
|
||||
integer(psb_lpk_), allocatable :: ia(:),ja(:)
|
||||
!integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave
|
||||
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
|
||||
logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
|
||||
integer(psb_ipk_), save :: idx_spspmm=-1, idx_prolcnv=-1, idx_proltrans=-1, idx_asb=-1
|
||||
|
||||
name='amg_parmatch_spmm_bld_inner'
|
||||
|
||||
@@ -488,7 +488,7 @@ subroutine amg_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
|
||||
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nrl, nzl, ip, &
|
||||
& nzt, naggrm1, naggrp1, i, k
|
||||
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
|
||||
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
|
||||
logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
|
||||
integer(psb_ipk_), save :: idx_spspmm=-1
|
||||
|
||||
name='amg_ptap_bld'
|
||||
|
||||
@@ -103,7 +103,7 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
character(len=20) :: name, ch_err
|
||||
integer(psb_ipk_), save :: idx_soc1_p1=-1, idx_soc1_p2=-1, idx_soc1_p3=-1
|
||||
integer(psb_ipk_), save :: idx_soc1_p0=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_soc1_map_bld'
|
||||
|
||||
@@ -104,7 +104,7 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
character(len=20) :: name, ch_err
|
||||
integer(psb_ipk_), save :: idx_soc2_p1=-1, idx_soc2_p2=-1, idx_soc2_p3=-1
|
||||
integer(psb_ipk_), save :: idx_soc2_p0=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_soc2_map_bld'
|
||||
|
||||
@@ -80,7 +80,7 @@ subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
& a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod
|
||||
use amg_s_prec_type
|
||||
use amg_s_symdec_aggregator_mod, amg_protect_name => amg_s_symdec_aggregator_build_tprol
|
||||
use amg_s_symdec_aggregator_mod, only : amg_s_symdec_aggregator_type
|
||||
use amg_s_inner_mod
|
||||
implicit none
|
||||
class(amg_s_symdec_aggregator_type), target, intent(inout) :: ag
|
||||
@@ -103,6 +103,16 @@ subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
logical :: clean_zeros
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine psb_saplusat(ain,aout,info)
|
||||
!!$ use psb_s_mat_mod, only : psb_sspmat_type
|
||||
!!$ import :: psb_ipk_
|
||||
!!$ implicit none
|
||||
!!$ type(psb_sspmat_type) :: ain, aout
|
||||
!!$ integer(psb_ipk_) :: info
|
||||
!!$ end subroutine psb_saplusat
|
||||
!!$ end interface
|
||||
!!$
|
||||
name='amg_s_symdec_aggregator_tprol'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
@@ -123,15 +133,11 @@ subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
|
||||
|
||||
nr = a%get_nrows()
|
||||
call a%csclip(atmp,info,imax=nr,jmax=nr,&
|
||||
call a%csclip(atrans,info,imax=nr,jmax=nr,&
|
||||
& rscale=.false.,cscale=.false.)
|
||||
call atmp%set_nrows(nr)
|
||||
call atmp%set_ncols(nr)
|
||||
if (info == psb_success_) call atmp%transp(atrans)
|
||||
if (info == psb_success_) call atrans%cscnv(info,type='COO')
|
||||
if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.)
|
||||
call atmp%set_nrows(nr)
|
||||
call atmp%set_ncols(nr)
|
||||
call atrans%set_nrows(nr)
|
||||
call atrans%set_ncols(nr)
|
||||
call psb_aplusat(atrans,atmp,info)
|
||||
if (info == psb_success_) call atrans%free()
|
||||
if (info == psb_success_) call atmp%cscnv(info,type='CSR')
|
||||
|
||||
|
||||
@@ -488,7 +488,7 @@ subroutine amg_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
|
||||
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nrl, nzl, ip, &
|
||||
& nzt, naggrm1, naggrp1, i, k
|
||||
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
|
||||
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
|
||||
logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
|
||||
integer(psb_ipk_), save :: idx_spspmm=-1
|
||||
|
||||
name='amg_ptap_bld'
|
||||
|
||||
@@ -103,7 +103,7 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
character(len=20) :: name, ch_err
|
||||
integer(psb_ipk_), save :: idx_soc1_p1=-1, idx_soc1_p2=-1, idx_soc1_p3=-1
|
||||
integer(psb_ipk_), save :: idx_soc1_p0=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_soc1_map_bld'
|
||||
|
||||
@@ -104,7 +104,7 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
character(len=20) :: name, ch_err
|
||||
integer(psb_ipk_), save :: idx_soc2_p1=-1, idx_soc2_p2=-1, idx_soc2_p3=-1
|
||||
integer(psb_ipk_), save :: idx_soc2_p0=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_soc2_map_bld'
|
||||
|
||||
@@ -80,7 +80,7 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
& a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod
|
||||
use amg_z_prec_type
|
||||
use amg_z_symdec_aggregator_mod, amg_protect_name => amg_z_symdec_aggregator_build_tprol
|
||||
use amg_z_symdec_aggregator_mod, only : amg_z_symdec_aggregator_type
|
||||
use amg_z_inner_mod
|
||||
implicit none
|
||||
class(amg_z_symdec_aggregator_type), target, intent(inout) :: ag
|
||||
@@ -103,6 +103,16 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
logical :: clean_zeros
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine psb_zaplusat(ain,aout,info)
|
||||
!!$ use psb_z_mat_mod, only : psb_zspmat_type
|
||||
!!$ import :: psb_ipk_
|
||||
!!$ implicit none
|
||||
!!$ type(psb_zspmat_type) :: ain, aout
|
||||
!!$ integer(psb_ipk_) :: info
|
||||
!!$ end subroutine psb_zaplusat
|
||||
!!$ end interface
|
||||
!!$
|
||||
name='amg_z_symdec_aggregator_tprol'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
@@ -123,15 +133,11 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
|
||||
|
||||
nr = a%get_nrows()
|
||||
call a%csclip(atmp,info,imax=nr,jmax=nr,&
|
||||
call a%csclip(atrans,info,imax=nr,jmax=nr,&
|
||||
& rscale=.false.,cscale=.false.)
|
||||
call atmp%set_nrows(nr)
|
||||
call atmp%set_ncols(nr)
|
||||
if (info == psb_success_) call atmp%transp(atrans)
|
||||
if (info == psb_success_) call atrans%cscnv(info,type='COO')
|
||||
if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.)
|
||||
call atmp%set_nrows(nr)
|
||||
call atmp%set_ncols(nr)
|
||||
call atrans%set_nrows(nr)
|
||||
call atrans%set_ncols(nr)
|
||||
call psb_aplusat(atrans,atmp,info)
|
||||
if (info == psb_success_) call atrans%free()
|
||||
if (info == psb_success_) call atmp%cscnv(info,type='CSR')
|
||||
|
||||
|
||||
@@ -81,8 +81,7 @@
|
||||
subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
!use amg_c_inner_mod
|
||||
use amg_c_prec_mod, amg_protect_name => amg_c_smoothers_bld
|
||||
use amg_c_prec_type, amg_protect_name => amg_c_smoothers_bld
|
||||
|
||||
Implicit None
|
||||
|
||||
|
||||
@@ -112,7 +112,11 @@ typedef struct {
|
||||
|
||||
int amg_cslu_fact(int n, int nnz,
|
||||
#ifdef AMG_HAVE_SLU
|
||||
#if (AMG_SLU_VERSION >= 7)
|
||||
singlecomplex *values,
|
||||
#else
|
||||
complex *values,
|
||||
#endif
|
||||
#else
|
||||
void *values,
|
||||
#endif
|
||||
@@ -177,10 +181,10 @@ int amg_cslu_fact(int n, int nnz,
|
||||
|
||||
panel_size = sp_ienv(1);
|
||||
relax = sp_ienv(2);
|
||||
#if defined(AMG_SLU_VERSION_5)
|
||||
#if (AMG_SLU_VERSION >= 7) || (AMG_SLU_VERSION == 5)
|
||||
cgstrf(&options, &AC, relax, panel_size, etree,
|
||||
NULL, 0, perm_c, perm_r, L, U, &Glu, &stat, &info);
|
||||
#elif defined(AMG_SLU_VERSION_4)
|
||||
#elif (AMG_SLU_VERSION == 4)
|
||||
cgstrf(&options, &AC, relax, panel_size, etree,
|
||||
NULL, 0, perm_c, perm_r, L, U, &stat, &info);
|
||||
#else
|
||||
@@ -230,7 +234,11 @@ int amg_cslu_fact(int n, int nnz,
|
||||
|
||||
int amg_cslu_solve(int itrans, int n, int nrhs,
|
||||
#ifdef AMG_HAVE_SLU
|
||||
#if (AMG_SLU_VERSION == 7)
|
||||
singlecomplex *b,
|
||||
#else
|
||||
complex *b,
|
||||
#endif
|
||||
#else
|
||||
void *b,
|
||||
#endif
|
||||
|
||||
@@ -81,8 +81,7 @@
|
||||
subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
!use amg_d_inner_mod
|
||||
use amg_d_prec_mod, amg_protect_name => amg_d_smoothers_bld
|
||||
use amg_d_prec_type, amg_protect_name => amg_d_smoothers_bld
|
||||
|
||||
Implicit None
|
||||
|
||||
|
||||
@@ -171,10 +171,10 @@ int amg_dslu_fact(int n, int nnz, double *values,
|
||||
|
||||
panel_size = sp_ienv(1);
|
||||
relax = sp_ienv(2);
|
||||
#if defined(AMG_SLU_VERSION_5)
|
||||
#if (AMG_SLU_VERSION >= 7) || (AMG_SLU_VERSION == 5)
|
||||
dgstrf(&options, &AC, relax, panel_size, etree,
|
||||
NULL, 0, perm_c, perm_r, L, U, &Glu, &stat, &info);
|
||||
#elif defined(AMG_SLU_VERSION_4)
|
||||
#elif (AMG_SLU_VERSION == 4)
|
||||
dgstrf(&options, &AC, relax, panel_size, etree,
|
||||
NULL, 0, perm_c, perm_r, L, U, &stat, &info);
|
||||
#else
|
||||
|
||||
@@ -81,8 +81,7 @@
|
||||
subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
!use amg_s_inner_mod
|
||||
use amg_s_prec_mod, amg_protect_name => amg_s_smoothers_bld
|
||||
use amg_s_prec_type, amg_protect_name => amg_s_smoothers_bld
|
||||
|
||||
Implicit None
|
||||
|
||||
|
||||
@@ -172,10 +172,10 @@ int amg_sslu_fact(int n, int nnz, float *values,
|
||||
|
||||
panel_size = sp_ienv(1);
|
||||
relax = sp_ienv(2);
|
||||
#if defined(AMG_SLU_VERSION_5)
|
||||
#if (AMG_SLU_VERSION >= 7) || (AMG_SLU_VERSION == 5)
|
||||
sgstrf(&options, &AC, relax, panel_size,
|
||||
etree, NULL, 0, perm_c, perm_r, L, U, &Glu, &stat, &info);
|
||||
#elif defined(AMG_SLU_VERSION_4)
|
||||
#elif (AMG_SLU_VERSION == 4)
|
||||
sgstrf(&options, &AC, relax, panel_size,
|
||||
etree, NULL, 0, perm_c, perm_r, L, U, &stat, &info);
|
||||
#else
|
||||
|
||||
@@ -81,8 +81,7 @@
|
||||
subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
!use amg_z_inner_mod
|
||||
use amg_z_prec_mod, amg_protect_name => amg_z_smoothers_bld
|
||||
use amg_z_prec_type, amg_protect_name => amg_z_smoothers_bld
|
||||
|
||||
Implicit None
|
||||
|
||||
|
||||
@@ -176,10 +176,10 @@ int amg_zslu_fact(int n, int nnz,
|
||||
|
||||
panel_size = sp_ienv(1);
|
||||
relax = sp_ienv(2);
|
||||
#if defined(AMG_SLU_VERSION_5)
|
||||
#if (AMG_SLU_VERSION >= 7) || (AMG_SLU_VERSION == 5)
|
||||
zgstrf(&options, &AC, relax, panel_size, etree,
|
||||
NULL, 0, perm_c, perm_r, L, U, &Glu, &stat, &info);
|
||||
#elif defined(AMG_SLU_VERSION_4)
|
||||
#elif (AMG_SLU_VERSION == 4)
|
||||
zgstrf(&options, &AC, relax, panel_size, etree,
|
||||
NULL, 0, perm_c, perm_r, L, U, &stat, &info);
|
||||
#else
|
||||
|
||||
@@ -55,8 +55,8 @@ subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt
|
||||
!!$ write(0,*) 'Remap handling '
|
||||
block
|
||||
type(psb_ctxt_type) :: ctxt, nctxt
|
||||
integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
|
||||
integer(psb_ipk_) :: me, np, rme, rnp
|
||||
integer(psb_mpk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
|
||||
integer(psb_mpk_) :: me, np, rme, rnp
|
||||
complex(psb_spk_), allocatable :: rsnd(:), rrcv(:)
|
||||
type(psb_c_vect_type) :: tv
|
||||
|
||||
|
||||
@@ -56,8 +56,8 @@ subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
|
||||
!!$ write(0,*) 'Remap handling not implemented yet '
|
||||
block
|
||||
type(psb_ctxt_type) :: ctxt, nctxt
|
||||
integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp
|
||||
integer(psb_ipk_) :: me, np, rme, rnp
|
||||
integer(psb_mpk_) :: i,j,ip, idest, nsrc, nrl, kp
|
||||
integer(psb_mpk_) :: me, np, rme, rnp
|
||||
complex(psb_spk_), allocatable :: rsnd(:), rrcv(:)
|
||||
type(psb_c_vect_type) :: tv
|
||||
|
||||
|
||||
@@ -55,8 +55,8 @@ subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt
|
||||
!!$ write(0,*) 'Remap handling '
|
||||
block
|
||||
type(psb_ctxt_type) :: ctxt, nctxt
|
||||
integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
|
||||
integer(psb_ipk_) :: me, np, rme, rnp
|
||||
integer(psb_mpk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
|
||||
integer(psb_mpk_) :: me, np, rme, rnp
|
||||
real(psb_dpk_), allocatable :: rsnd(:), rrcv(:)
|
||||
type(psb_d_vect_type) :: tv
|
||||
|
||||
|
||||
@@ -56,8 +56,8 @@ subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
|
||||
!!$ write(0,*) 'Remap handling not implemented yet '
|
||||
block
|
||||
type(psb_ctxt_type) :: ctxt, nctxt
|
||||
integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp
|
||||
integer(psb_ipk_) :: me, np, rme, rnp
|
||||
integer(psb_mpk_) :: i,j,ip, idest, nsrc, nrl, kp
|
||||
integer(psb_mpk_) :: me, np, rme, rnp
|
||||
real(psb_dpk_), allocatable :: rsnd(:), rrcv(:)
|
||||
type(psb_d_vect_type) :: tv
|
||||
|
||||
|
||||
@@ -55,8 +55,8 @@ subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt
|
||||
!!$ write(0,*) 'Remap handling '
|
||||
block
|
||||
type(psb_ctxt_type) :: ctxt, nctxt
|
||||
integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
|
||||
integer(psb_ipk_) :: me, np, rme, rnp
|
||||
integer(psb_mpk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
|
||||
integer(psb_mpk_) :: me, np, rme, rnp
|
||||
real(psb_spk_), allocatable :: rsnd(:), rrcv(:)
|
||||
type(psb_s_vect_type) :: tv
|
||||
|
||||
|
||||
@@ -56,8 +56,8 @@ subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
|
||||
!!$ write(0,*) 'Remap handling not implemented yet '
|
||||
block
|
||||
type(psb_ctxt_type) :: ctxt, nctxt
|
||||
integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp
|
||||
integer(psb_ipk_) :: me, np, rme, rnp
|
||||
integer(psb_mpk_) :: i,j,ip, idest, nsrc, nrl, kp
|
||||
integer(psb_mpk_) :: me, np, rme, rnp
|
||||
real(psb_spk_), allocatable :: rsnd(:), rrcv(:)
|
||||
type(psb_s_vect_type) :: tv
|
||||
|
||||
|
||||
@@ -55,8 +55,8 @@ subroutine amg_z_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt
|
||||
!!$ write(0,*) 'Remap handling '
|
||||
block
|
||||
type(psb_ctxt_type) :: ctxt, nctxt
|
||||
integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
|
||||
integer(psb_ipk_) :: me, np, rme, rnp
|
||||
integer(psb_mpk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp
|
||||
integer(psb_mpk_) :: me, np, rme, rnp
|
||||
complex(psb_dpk_), allocatable :: rsnd(:), rrcv(:)
|
||||
type(psb_z_vect_type) :: tv
|
||||
|
||||
|
||||
@@ -56,8 +56,8 @@ subroutine amg_z_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
|
||||
!!$ write(0,*) 'Remap handling not implemented yet '
|
||||
block
|
||||
type(psb_ctxt_type) :: ctxt, nctxt
|
||||
integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp
|
||||
integer(psb_ipk_) :: me, np, rme, rnp
|
||||
integer(psb_mpk_) :: i,j,ip, idest, nsrc, nrl, kp
|
||||
integer(psb_mpk_) :: me, np, rme, rnp
|
||||
complex(psb_dpk_), allocatable :: rsnd(:), rrcv(:)
|
||||
type(psb_z_vect_type) :: tv
|
||||
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_c_as_smoother_clone(sm,smout,info)
|
||||
if (info == psb_success_) &
|
||||
& call sm%desc_data%clone(smo%desc_data,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -183,7 +183,7 @@ subroutine amg_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
end if
|
||||
if ( res < sm%tol*resdenum ) then
|
||||
if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) &
|
||||
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
|
||||
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
|
||||
exit
|
||||
end if
|
||||
end if
|
||||
@@ -275,7 +275,7 @@ subroutine amg_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
end if
|
||||
if (res < sm%tol*resdenum ) then
|
||||
if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) &
|
||||
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
|
||||
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
|
||||
exit
|
||||
end if
|
||||
end if
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_c_jac_smoother_clone(sm,smout,info)
|
||||
smo%tol = sm%tol
|
||||
call sm%nd%clone(smo%nd,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_d_as_smoother_clone(sm,smout,info)
|
||||
if (info == psb_success_) &
|
||||
& call sm%desc_data%clone(smo%desc_data,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -183,7 +183,7 @@ subroutine amg_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
end if
|
||||
if ( res < sm%tol*resdenum ) then
|
||||
if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) &
|
||||
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
|
||||
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
|
||||
exit
|
||||
end if
|
||||
end if
|
||||
@@ -275,7 +275,7 @@ subroutine amg_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
end if
|
||||
if (res < sm%tol*resdenum ) then
|
||||
if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) &
|
||||
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
|
||||
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
|
||||
exit
|
||||
end if
|
||||
end if
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_d_jac_smoother_clone(sm,smout,info)
|
||||
smo%tol = sm%tol
|
||||
call sm%nd%clone(smo%nd,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
! Timers
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
integer(psb_ipk_), save :: poly_1=-1, poly_2=-1, poly_3=-1
|
||||
integer(psb_ipk_), save :: poly_mv=-1, poly_sv=-1, poly_vect=-1
|
||||
!
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_s_as_smoother_clone(sm,smout,info)
|
||||
if (info == psb_success_) &
|
||||
& call sm%desc_data%clone(smo%desc_data,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -183,7 +183,7 @@ subroutine amg_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
end if
|
||||
if ( res < sm%tol*resdenum ) then
|
||||
if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) &
|
||||
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
|
||||
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
|
||||
exit
|
||||
end if
|
||||
end if
|
||||
@@ -275,7 +275,7 @@ subroutine amg_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
end if
|
||||
if (res < sm%tol*resdenum ) then
|
||||
if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) &
|
||||
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
|
||||
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
|
||||
exit
|
||||
end if
|
||||
end if
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_s_jac_smoother_clone(sm,smout,info)
|
||||
smo%tol = sm%tol
|
||||
call sm%nd%clone(smo%nd,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
character, intent(in), optional :: init
|
||||
type(psb_s_vect_type),intent(inout), optional :: initu
|
||||
! Timers
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
integer(psb_ipk_), save :: poly_1=-1, poly_2=-1, poly_3=-1
|
||||
integer(psb_ipk_), save :: poly_mv=-1, poly_sv=-1, poly_vect=-1
|
||||
!
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_z_as_smoother_clone(sm,smout,info)
|
||||
if (info == psb_success_) &
|
||||
& call sm%desc_data%clone(smo%desc_data,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -183,7 +183,7 @@ subroutine amg_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
end if
|
||||
if ( res < sm%tol*resdenum ) then
|
||||
if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) &
|
||||
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
|
||||
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
|
||||
exit
|
||||
end if
|
||||
end if
|
||||
@@ -275,7 +275,7 @@ subroutine amg_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
end if
|
||||
if (res < sm%tol*resdenum ) then
|
||||
if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) &
|
||||
& call log_conv("BJAC",me,i,1,res,resdenum,sm%tol)
|
||||
& call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol)
|
||||
exit
|
||||
end if
|
||||
end if
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_z_jac_smoother_clone(sm,smout,info)
|
||||
smo%tol = sm%tol
|
||||
call sm%nd%clone(smo%nd,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -54,6 +54,7 @@ amg_c_mumps_solver_apply.o \
|
||||
amg_c_mumps_solver_apply_vect.o \
|
||||
amg_c_mumps_solver_bld.o \
|
||||
amg_c_krm_solver_impl.o \
|
||||
amg_c_slu_solver_impl.o \
|
||||
amg_d_base_solver_apply.o \
|
||||
amg_d_base_solver_apply_vect.o \
|
||||
amg_d_base_solver_bld.o \
|
||||
@@ -101,6 +102,8 @@ amg_d_mumps_solver_apply.o \
|
||||
amg_d_mumps_solver_apply_vect.o \
|
||||
amg_d_mumps_solver_bld.o \
|
||||
amg_d_krm_solver_impl.o \
|
||||
amg_d_slu_solver_impl.o \
|
||||
amg_d_umf_solver_impl.o \
|
||||
amg_s_base_solver_apply.o \
|
||||
amg_s_base_solver_apply_vect.o \
|
||||
amg_s_base_solver_bld.o \
|
||||
@@ -148,6 +151,7 @@ amg_s_mumps_solver_apply.o \
|
||||
amg_s_mumps_solver_apply_vect.o \
|
||||
amg_s_mumps_solver_bld.o \
|
||||
amg_s_krm_solver_impl.o \
|
||||
amg_s_slu_solver_impl.o \
|
||||
amg_z_base_solver_apply.o \
|
||||
amg_z_base_solver_apply_vect.o \
|
||||
amg_z_base_solver_bld.o \
|
||||
@@ -303,6 +307,8 @@ amg_z_invk_solver_clone_settings.o \
|
||||
amg_z_invk_solver_cseti.o \
|
||||
amg_z_invk_solver_descr.o \
|
||||
amg_z_krm_solver_impl.o \
|
||||
amg_z_slu_solver_impl.o \
|
||||
amg_z_umf_solver_impl.o \
|
||||
amg_c_jac_solver_clone_settings.o \
|
||||
amg_c_jac_solver_clear_data.o \
|
||||
amg_c_jac_solver_cnv.o \
|
||||
|
||||
@@ -57,7 +57,7 @@ subroutine amg_c_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
integer(psb_ipk_) :: np, me, i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_bwgs_solver_bld', ch_err
|
||||
integer(psb_ipk_), save :: idx_tril=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -57,7 +57,7 @@ subroutine amg_c_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
integer(psb_ipk_) :: np, me, i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='c_gs_solver_bld', ch_err
|
||||
integer(psb_ipk_), save :: idx_tril=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -96,9 +96,10 @@ subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
|
||||
integer(psb_lpk_) :: lnr
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
|
||||
integer(psb_mpk_) :: np,me
|
||||
type(psb_ctxt_type) :: ctxt, l_ctxt
|
||||
character(len=20) :: name='@Z@_krm_solver_bld', ch_err
|
||||
character(len=20) :: name='c_krm_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -123,7 +124,7 @@ subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
call sv%prec%smoothers_build(a,desc_a,info,amold=amold,vmold=vmold)
|
||||
sv%a => a
|
||||
else
|
||||
call psb_init(l_ctxt,np=1_psb_ipk_,basectxt=ctxt,ids=(/me/))
|
||||
call psb_init(l_ctxt,np=1_psb_mpk_,basectxt=ctxt,ids=(/me/))
|
||||
n_row = desc_a%get_local_rows()
|
||||
lnr = n_row
|
||||
call psb_cdall(l_ctxt,sv%desc_local,info,mg=lnr,repl=.true.)
|
||||
@@ -186,9 +187,10 @@ subroutine amg_c_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
type(psb_c_vect_type),intent(inout), optional :: initu
|
||||
|
||||
type(psb_c_vect_type) :: z
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
|
||||
integer(psb_mpk_) :: np,me
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err
|
||||
character(len=20) :: name='c_krm_solver_apply_v', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -247,9 +249,10 @@ subroutine amg_c_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_spk_),intent(inout), optional :: initu(:)
|
||||
complex(psb_spk_), allocatable :: z(:)
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
|
||||
integer(psb_mpk_) :: np,me
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
character(len=20) :: name='@Z@_krm_solver_apply', ch_err
|
||||
character(len=20) :: name='c_krm_solver_apply', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -0,0 +1,204 @@
|
||||
#if !defined(PSB_IPK8)
|
||||
subroutine amg_c_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
use amg_c_slu_solver, amg_protect_name => amg_c_slu_solver_bld
|
||||
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
|
||||
! 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(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='s_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 amg_c_slu_solver_bld
|
||||
|
||||
subroutine amg_c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_c_slu_solver, amg_protect_name => amg_c_slu_solver_apply_vect
|
||||
|
||||
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
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_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 amg_c_slu_solver_apply_vect
|
||||
|
||||
subroutine amg_c_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_c_slu_solver, amg_protect_name => amg_c_slu_solver_apply
|
||||
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(:)
|
||||
|
||||
integer(psb_ipk_) :: n_row,n_col
|
||||
complex(psb_spk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='s_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 amg_c_slu_solver_apply
|
||||
#endif
|
||||
@@ -0,0 +1,204 @@
|
||||
#if !defined(PSB_IPK8)
|
||||
subroutine amg_c_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_c_umf_solver, amg_protect_name => amg_c_umf_solver_apply
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_umf_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(:)
|
||||
|
||||
integer(psb_ipk_) :: n_row,n_col
|
||||
complex(psb_spk_), pointer :: ww(:)
|
||||
integer(psb_ipk_) :: i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='c_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='complex(psb_spk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_cumf_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_c_is_complex_) then
|
||||
info = amg_cumf_solve(2,n_row,ww,x,n_row,sv%numeric)
|
||||
else
|
||||
info = amg_cumf_solve(1,n_row,ww,x,n_row,sv%numeric)
|
||||
end if
|
||||
case('C')
|
||||
info = amg_cumf_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 amg_c_umf_solver_apply
|
||||
|
||||
subroutine amg_c_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_c_umf_solver, amg_protect_name => amg_c_umf_solver_apply_vect
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_umf_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
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_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 amg_c_umf_solver_apply_vect
|
||||
|
||||
subroutine amg_c_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
use amg_c_umf_solver, amg_protect_name => amg_c_umf_solver_bld
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_umf_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
|
||||
! Local variables
|
||||
type(psb_cspmat_type) :: atmp
|
||||
type(psb_c_csc_sparse_mat) :: acsc
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='c_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_cumf_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_cumf_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 amg_c_umf_solver_bld
|
||||
#endif
|
||||
@@ -57,7 +57,7 @@ subroutine amg_d_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
integer(psb_ipk_) :: np, me, i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_bwgs_solver_bld', ch_err
|
||||
integer(psb_ipk_), save :: idx_tril=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -57,7 +57,7 @@ subroutine amg_d_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
integer(psb_ipk_) :: np, me, i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_gs_solver_bld', ch_err
|
||||
integer(psb_ipk_), save :: idx_tril=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -96,9 +96,10 @@ subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
|
||||
integer(psb_lpk_) :: lnr
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
|
||||
integer(psb_mpk_) :: np,me
|
||||
type(psb_ctxt_type) :: ctxt, l_ctxt
|
||||
character(len=20) :: name='@Z@_krm_solver_bld', ch_err
|
||||
character(len=20) :: name='d_krm_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -123,7 +124,7 @@ subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
call sv%prec%smoothers_build(a,desc_a,info,amold=amold,vmold=vmold)
|
||||
sv%a => a
|
||||
else
|
||||
call psb_init(l_ctxt,np=1_psb_ipk_,basectxt=ctxt,ids=(/me/))
|
||||
call psb_init(l_ctxt,np=1_psb_mpk_,basectxt=ctxt,ids=(/me/))
|
||||
n_row = desc_a%get_local_rows()
|
||||
lnr = n_row
|
||||
call psb_cdall(l_ctxt,sv%desc_local,info,mg=lnr,repl=.true.)
|
||||
@@ -186,9 +187,10 @@ subroutine amg_d_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
|
||||
type(psb_d_vect_type) :: z
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
|
||||
integer(psb_mpk_) :: np,me
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err
|
||||
character(len=20) :: name='d_krm_solver_apply_v', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -247,9 +249,10 @@ subroutine amg_d_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
real(psb_dpk_), allocatable :: z(:)
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
|
||||
integer(psb_mpk_) :: np,me
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
character(len=20) :: name='@Z@_krm_solver_apply', ch_err
|
||||
character(len=20) :: name='d_krm_solver_apply', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -0,0 +1,204 @@
|
||||
#if !defined(PSB_IPK8)
|
||||
subroutine amg_d_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
use amg_d_slu_solver, amg_protect_name => amg_d_slu_solver_bld
|
||||
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
|
||||
! 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(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='s_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 amg_d_slu_solver_bld
|
||||
|
||||
subroutine amg_d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_d_slu_solver, amg_protect_name => amg_d_slu_solver_apply_vect
|
||||
|
||||
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
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_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 amg_d_slu_solver_apply_vect
|
||||
|
||||
subroutine amg_d_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_d_slu_solver, amg_protect_name => amg_d_slu_solver_apply
|
||||
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(:)
|
||||
|
||||
integer(psb_ipk_) :: n_row,n_col
|
||||
real(psb_dpk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='s_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 amg_d_slu_solver_apply
|
||||
#endif
|
||||
@@ -0,0 +1,204 @@
|
||||
#if !defined(PSB_IPK8)
|
||||
subroutine amg_d_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_d_umf_solver, amg_protect_name => amg_d_umf_solver_apply
|
||||
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(:)
|
||||
|
||||
integer(psb_ipk_) :: 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 amg_d_umf_solver_apply
|
||||
|
||||
subroutine amg_d_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_d_umf_solver, amg_protect_name => amg_d_umf_solver_apply_vect
|
||||
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
|
||||
|
||||
integer(psb_ipk_) :: 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 amg_d_umf_solver_apply_vect
|
||||
|
||||
subroutine amg_d_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
use amg_d_umf_solver, amg_protect_name => amg_d_umf_solver_bld
|
||||
|
||||
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
|
||||
! 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(psb_ipk_) :: 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 amg_d_umf_solver_bld
|
||||
#endif
|
||||
@@ -57,7 +57,7 @@ subroutine amg_s_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
integer(psb_ipk_) :: np, me, i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_bwgs_solver_bld', ch_err
|
||||
integer(psb_ipk_), save :: idx_tril=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -57,7 +57,7 @@ subroutine amg_s_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
integer(psb_ipk_) :: np, me, i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='s_gs_solver_bld', ch_err
|
||||
integer(psb_ipk_), save :: idx_tril=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -96,9 +96,10 @@ subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
|
||||
integer(psb_lpk_) :: lnr
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
|
||||
integer(psb_mpk_) :: np,me
|
||||
type(psb_ctxt_type) :: ctxt, l_ctxt
|
||||
character(len=20) :: name='@Z@_krm_solver_bld', ch_err
|
||||
character(len=20) :: name='s_krm_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -123,7 +124,7 @@ subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
call sv%prec%smoothers_build(a,desc_a,info,amold=amold,vmold=vmold)
|
||||
sv%a => a
|
||||
else
|
||||
call psb_init(l_ctxt,np=1_psb_ipk_,basectxt=ctxt,ids=(/me/))
|
||||
call psb_init(l_ctxt,np=1_psb_mpk_,basectxt=ctxt,ids=(/me/))
|
||||
n_row = desc_a%get_local_rows()
|
||||
lnr = n_row
|
||||
call psb_cdall(l_ctxt,sv%desc_local,info,mg=lnr,repl=.true.)
|
||||
@@ -186,9 +187,10 @@ subroutine amg_s_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
type(psb_s_vect_type),intent(inout), optional :: initu
|
||||
|
||||
type(psb_s_vect_type) :: z
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
|
||||
integer(psb_mpk_) :: np,me
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err
|
||||
character(len=20) :: name='s_krm_solver_apply_v', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -247,9 +249,10 @@ subroutine amg_s_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
character, intent(in), optional :: init
|
||||
real(psb_spk_),intent(inout), optional :: initu(:)
|
||||
real(psb_spk_), allocatable :: z(:)
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
|
||||
integer(psb_mpk_) :: np,me
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
character(len=20) :: name='@Z@_krm_solver_apply', ch_err
|
||||
character(len=20) :: name='s_krm_solver_apply', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -0,0 +1,204 @@
|
||||
#if !defined(PSB_IPK8)
|
||||
subroutine amg_s_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
use amg_s_slu_solver, amg_protect_name => amg_s_slu_solver_bld
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
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
|
||||
! Local variables
|
||||
type(psb_sspmat_type) :: atmp
|
||||
type(psb_s_csc_sparse_mat) :: acsc
|
||||
type(psb_s_coo_sparse_mat) :: acoo
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='s_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_sslu_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_sslu_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 amg_s_slu_solver_bld
|
||||
|
||||
subroutine amg_s_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_s_slu_solver, amg_protect_name => amg_s_slu_solver_apply_vect
|
||||
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_slu_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
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_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 amg_s_slu_solver_apply_vect
|
||||
|
||||
subroutine amg_s_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_s_slu_solver, amg_protect_name => amg_s_slu_solver_apply
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_slu_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(:)
|
||||
|
||||
integer(psb_ipk_) :: n_row,n_col
|
||||
real(psb_spk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='s_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_spk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
ww(1:n_row) = x(1:n_row)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_sslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('T')
|
||||
info = amg_sslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('C')
|
||||
info = amg_sslu_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 amg_s_slu_solver_apply
|
||||
#endif
|
||||
@@ -0,0 +1,204 @@
|
||||
#if !defined(PSB_IPK8)
|
||||
subroutine amg_s_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_s_umf_solver, amg_protect_name => amg_s_umf_solver_apply
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_umf_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(:)
|
||||
|
||||
integer(psb_ipk_) :: n_row,n_col
|
||||
real(psb_spk_), pointer :: ww(:)
|
||||
integer(psb_ipk_) :: i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='s_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_spk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_sumf_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_s_is_complex_) then
|
||||
info = amg_sumf_solve(2,n_row,ww,x,n_row,sv%numeric)
|
||||
else
|
||||
info = amg_sumf_solve(1,n_row,ww,x,n_row,sv%numeric)
|
||||
end if
|
||||
case('C')
|
||||
info = amg_sumf_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 amg_s_umf_solver_apply
|
||||
|
||||
subroutine amg_s_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_s_umf_solver, amg_protect_name => amg_s_umf_solver_apply_vect
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_umf_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
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_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 amg_s_umf_solver_apply_vect
|
||||
|
||||
subroutine amg_s_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
use amg_s_umf_solver, amg_protect_name => amg_s_umf_solver_bld
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_umf_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
|
||||
! Local variables
|
||||
type(psb_sspmat_type) :: atmp
|
||||
type(psb_s_csc_sparse_mat) :: acsc
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='s_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_sumf_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_sumf_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 amg_s_umf_solver_bld
|
||||
#endif
|
||||
@@ -57,7 +57,7 @@ subroutine amg_z_bwgs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
integer(psb_ipk_) :: np, me, i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_bwgs_solver_bld', ch_err
|
||||
integer(psb_ipk_), save :: idx_tril=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -57,7 +57,7 @@ subroutine amg_z_gs_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
integer(psb_ipk_) :: np, me, i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='z_gs_solver_bld', ch_err
|
||||
integer(psb_ipk_), save :: idx_tril=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -96,9 +96,10 @@ subroutine amg_z_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
|
||||
integer(psb_lpk_) :: lnr
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
|
||||
integer(psb_mpk_) :: np,me
|
||||
type(psb_ctxt_type) :: ctxt, l_ctxt
|
||||
character(len=20) :: name='@Z@_krm_solver_bld', ch_err
|
||||
character(len=20) :: name='z_krm_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -123,7 +124,7 @@ subroutine amg_z_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
call sv%prec%smoothers_build(a,desc_a,info,amold=amold,vmold=vmold)
|
||||
sv%a => a
|
||||
else
|
||||
call psb_init(l_ctxt,np=1_psb_ipk_,basectxt=ctxt,ids=(/me/))
|
||||
call psb_init(l_ctxt,np=1_psb_mpk_,basectxt=ctxt,ids=(/me/))
|
||||
n_row = desc_a%get_local_rows()
|
||||
lnr = n_row
|
||||
call psb_cdall(l_ctxt,sv%desc_local,info,mg=lnr,repl=.true.)
|
||||
@@ -186,9 +187,10 @@ subroutine amg_z_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
type(psb_z_vect_type),intent(inout), optional :: initu
|
||||
|
||||
type(psb_z_vect_type) :: z
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
|
||||
integer(psb_mpk_) :: np,me
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err
|
||||
character(len=20) :: name='z_krm_solver_apply_v', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -247,9 +249,10 @@ subroutine amg_z_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
complex(psb_dpk_), allocatable :: z(:)
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
|
||||
integer(psb_mpk_) :: np,me
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
character(len=20) :: name='@Z@_krm_solver_apply', ch_err
|
||||
character(len=20) :: name='z_krm_solver_apply', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -0,0 +1,204 @@
|
||||
#if !defined(PSB_IPK8)
|
||||
subroutine amg_z_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
use amg_z_slu_solver, amg_protect_name => amg_z_slu_solver_bld
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_zspmat_type), intent(in), target, optional :: b
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_zspmat_type) :: atmp
|
||||
type(psb_z_csc_sparse_mat) :: acsc
|
||||
type(psb_z_coo_sparse_mat) :: acoo
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='s_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_zslu_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_zslu_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 amg_z_slu_solver_bld
|
||||
|
||||
subroutine amg_z_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_z_slu_solver, amg_protect_name => amg_z_slu_solver_apply_vect
|
||||
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_z_vect_type),intent(inout) :: x
|
||||
type(psb_z_vect_type),intent(inout) :: y
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_z_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_z_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_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 amg_z_slu_solver_apply_vect
|
||||
|
||||
subroutine amg_z_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_z_slu_solver, amg_protect_name => amg_z_slu_solver_apply
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
complex(psb_dpk_),intent(inout) :: x(:)
|
||||
complex(psb_dpk_),intent(inout) :: y(:)
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer(psb_ipk_) :: n_row,n_col
|
||||
complex(psb_dpk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='s_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_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
ww(1:n_row) = x(1:n_row)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_zslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('T')
|
||||
info = amg_zslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('C')
|
||||
info = amg_zslu_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 amg_z_slu_solver_apply
|
||||
#endif
|
||||
@@ -0,0 +1,204 @@
|
||||
#if !defined(PSB_IPK8)
|
||||
subroutine amg_z_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_z_umf_solver, amg_protect_name => amg_z_umf_solver_apply
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
complex(psb_dpk_),intent(inout) :: x(:)
|
||||
complex(psb_dpk_),intent(inout) :: y(:)
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer(psb_ipk_) :: n_row,n_col
|
||||
complex(psb_dpk_), pointer :: ww(:)
|
||||
integer(psb_ipk_) :: i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='z_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='complex(psb_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_zumf_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_z_is_complex_) then
|
||||
info = amg_zumf_solve(2,n_row,ww,x,n_row,sv%numeric)
|
||||
else
|
||||
info = amg_zumf_solve(1,n_row,ww,x,n_row,sv%numeric)
|
||||
end if
|
||||
case('C')
|
||||
info = amg_zumf_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 amg_z_umf_solver_apply
|
||||
|
||||
subroutine amg_z_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
use amg_z_umf_solver, amg_protect_name => amg_z_umf_solver_apply_vect
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
type(psb_z_vect_type),intent(inout) :: x
|
||||
type(psb_z_vect_type),intent(inout) :: y
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_z_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_z_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='z_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 amg_z_umf_solver_apply_vect
|
||||
|
||||
subroutine amg_z_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
use amg_z_umf_solver, amg_protect_name => amg_z_umf_solver_bld
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_zspmat_type), intent(in), target, optional :: b
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_zspmat_type) :: atmp
|
||||
type(psb_z_csc_sparse_mat) :: acsc
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='z_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_zumf_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_zumf_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 amg_z_umf_solver_bld
|
||||
#endif
|
||||
@@ -0,0 +1,30 @@
|
||||
set(AMG_amgcbind_source_files
|
||||
amgprec/amg_zprec_cbind_mod.F90
|
||||
amgprec/amg_prec_cbind_mod.F90
|
||||
amgprec/amg_dprec_cbind_mod.F90
|
||||
)
|
||||
foreach(file IN LISTS AMG_amgcbind_source_files)
|
||||
list(APPEND amgcbind_source_files ${CMAKE_CURRENT_LIST_DIR}/${file})
|
||||
endforeach()
|
||||
|
||||
set(AMG_amgcbind_source_C_files
|
||||
amgprec/amg_c_zprec.c
|
||||
amgprec/amg_c_dprec.c
|
||||
)
|
||||
|
||||
|
||||
foreach(file IN LISTS AMG_amgcbind_source_C_files)
|
||||
list(APPEND amgcbind_source_C_files ${CMAKE_CURRENT_LIST_DIR}/${file})
|
||||
endforeach()
|
||||
|
||||
set(AMG_amgcbind_header_C_files
|
||||
amgprec/amg_const.h
|
||||
amgprec/amg_c_dprec.h
|
||||
amgprec/amg_cbind.h
|
||||
amgprec/amg_c_zprec.h
|
||||
)
|
||||
|
||||
|
||||
foreach(file IN LISTS AMG_amgcbind_header_C_files)
|
||||
list(APPEND amgcbind_header_C_files ${CMAKE_CURRENT_LIST_DIR}/${file})
|
||||
endforeach()
|
||||
@@ -7,6 +7,8 @@ INCDIR=../include
|
||||
MODDIR=../modules/
|
||||
LIBNAME=$(CBINDLIBNAME)
|
||||
LIBNAME=libamg_cbind.a
|
||||
AMGFDEFINES=-DPSB_HAVE_LAPACK -DPSB_HAVE_FLUSH_STMT -DPSB_MPI_MOD $(PSBFDEFINES) $(FCUDEFINES)
|
||||
FDEFINES=$(AMGFDEFINES)
|
||||
|
||||
objs: amgprecd
|
||||
|
||||
@@ -26,3 +28,4 @@ clean:
|
||||
veryclean: clean
|
||||
cd test/pargen && $(MAKE) clean
|
||||
/bin/rm -f $(HERE)/$(LIBNAME) $(LIBMOD) *$(.mod) *.h
|
||||
|
||||
|
||||
@@ -8,6 +8,8 @@ DEST=../
|
||||
|
||||
CINCLUDES=-I. -I$(INCDIR) -I$(PSBLAS_INCDIR)
|
||||
FINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(INCDIR) $(FMFLAG)$(MODDIR) $(PSBLAS_INCLUDES)
|
||||
AMGFDEFINES=-DPSB_HAVE_LAPACK -DPSB_HAVE_FLUSH_STMT -DPSB_MPI_MOD $(PSBFDEFINES) $(FCUDEFINES)
|
||||
FDEFINES=$(AMGFDEFINES)
|
||||
|
||||
|
||||
OBJS=amg_prec_cbind_mod.o amg_dprec_cbind_mod.o amg_c_dprec.o amg_zprec_cbind_mod.o amg_c_zprec.o
|
||||
|
||||
@@ -11,7 +11,7 @@ amg_c_dprec* amg_c_dprec_new()
|
||||
}
|
||||
|
||||
|
||||
int amg_c_dprec_delete(amg_c_dprec* p)
|
||||
psb_i_t amg_c_dprec_delete(amg_c_dprec* p)
|
||||
{
|
||||
int iret;
|
||||
iret=amg_c_dprecfree(p);
|
||||
|
||||
@@ -4,7 +4,7 @@
|
||||
#include "amg_const.h"
|
||||
#include "psb_base_cbind.h"
|
||||
#include "psb_prec_cbind.h"
|
||||
#include "psb_krylov_cbind.h"
|
||||
#include "psb_linsolve_cbind.h"
|
||||
|
||||
/* Object handle related routines */
|
||||
/* Note: amg_get_XXX_handle returns: <= 0 unsuccessful */
|
||||
@@ -26,10 +26,14 @@ extern "C" {
|
||||
psb_i_t amg_c_dprecbld(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_dprec *ph);
|
||||
psb_i_t amg_c_dhierarchy_build(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_dprec *ph);
|
||||
psb_i_t amg_c_dsmoothers_build(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_dprec *ph);
|
||||
psb_i_t amg_c_dsmoothers_build_opt(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_dprec *ph, const char *afmt, const char *chfmt);
|
||||
psb_i_t amg_c_dprecapply(amg_c_dprec *ph, psb_c_dvector *x, psb_c_dvector *b, psb_c_descriptor *cdh);
|
||||
psb_i_t amg_c_dprecapply_opt(amg_c_dprec *ph, psb_c_dvector *x, psb_c_dvector *b, psb_c_descriptor *cdh, const char *ctrans);
|
||||
psb_i_t amg_c_dprecfree(amg_c_dprec *ph);
|
||||
psb_i_t amg_c_dprecbld_opt(psb_c_dspmat *ah, psb_c_descriptor *cdh,
|
||||
amg_c_dprec *ph, const char *afmt);
|
||||
psb_i_t amg_c_ddescr(amg_c_dprec *ph);
|
||||
psb_i_t amg_c_dallocate_wrk(amg_c_dprec *ph, const char *chfmt);
|
||||
|
||||
psb_i_t amg_c_dkrylov(const char *method, psb_c_dspmat *ah, amg_c_dprec *ph,
|
||||
psb_c_dvector *bh, psb_c_dvector *xh,
|
||||
|
||||
@@ -11,7 +11,7 @@ amg_c_dprec* amg_c_new_dprec()
|
||||
}
|
||||
|
||||
|
||||
int amg_c_delete_dprec(amg_c_dprec* p)
|
||||
psb_i_t amg_c_delete_dprec(amg_c_dprec* p)
|
||||
{
|
||||
int iret;
|
||||
iret=amg_c_dprecfree(p);
|
||||
|
||||
+22
-17
@@ -4,38 +4,43 @@
|
||||
#include "amg_const.h"
|
||||
#include "psb_base_cbind.h"
|
||||
#include "psb_prec_cbind.h"
|
||||
#include "psb_krylov_cbind.h"
|
||||
#include "psb_linsolve_cbind.h"
|
||||
|
||||
/* Object handle related routines */
|
||||
/* Note: amg_get_XXX_handle returns: <= 0 unsuccessful */
|
||||
/* >0 valid handle */
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
extern "C"
|
||||
{
|
||||
#endif
|
||||
typedef struct AMG_C_ZPREC {
|
||||
typedef struct AMG_C_ZPREC
|
||||
{
|
||||
void *dprec;
|
||||
} amg_c_zprec;
|
||||
|
||||
amg_c_zprec* amg_c_zprec_new();
|
||||
psb_i_t amg_c_zprec_delete(amg_c_zprec* p);
|
||||
|
||||
} amg_c_zprec;
|
||||
|
||||
amg_c_zprec *amg_c_zprec_new();
|
||||
psb_i_t amg_c_zprec_delete(amg_c_zprec *p);
|
||||
|
||||
psb_i_t amg_c_zprecinit(psb_c_ctxt cctxt, amg_c_zprec *ph, const char *ptype);
|
||||
psb_i_t amg_c_zprecseti(amg_c_zprec *ph, const char *what, psb_i_t val);
|
||||
psb_i_t amg_c_zprecsetc(amg_c_zprec *ph, const char *what, const char *val);
|
||||
psb_i_t amg_c_zprecsetr(amg_c_zprec *ph, const char *what, double val);
|
||||
psb_i_t amg_c_zprecbld(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zhierarchy_build(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zsmoothers_build(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zprecbld(psb_c_zspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zhierarchy_build(psb_c_zspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zsmoothers_build(psb_c_zspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zsmoothers_build_opt(psb_c_zspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph, const char *afmt, const char *chfmt);
|
||||
psb_i_t amg_c_zprecapply(amg_c_zprec *ph, psb_c_zvector *x, psb_c_zvector *b, psb_c_descriptor *cdh);
|
||||
psb_i_t amg_c_zprecapply_opt(amg_c_zprec *ph, psb_c_zvector *x, psb_c_zvector *b, psb_c_descriptor *cdh, const char *ctrans);
|
||||
psb_i_t amg_c_zprecfree(amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zprecbld_opt(psb_c_zspmat *ah, psb_c_descriptor *cdh,
|
||||
amg_c_zprec *ph, const char *afmt);
|
||||
psb_i_t amg_c_zprecbld_opt(psb_c_zspmat *ah, psb_c_descriptor *cdh,
|
||||
amg_c_zprec *ph, const char *afmt);
|
||||
|
||||
psb_i_t amg_c_zdescr(amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zallocate_wrk(amg_c_zprec *ph, const char *chfmt);
|
||||
|
||||
psb_i_t amg_c_zkrylov(const char *method, psb_c_zspmat *ah, amg_c_zprec *ph,
|
||||
psb_c_zvector *bh, psb_c_zvector *xh,
|
||||
psb_c_descriptor *cdh, psb_c_SolverOptions *opt);
|
||||
|
||||
psb_i_t amg_c_zkrylov(const char *method, psb_c_zspmat *ah, amg_c_zprec *ph,
|
||||
psb_c_zvector *bh, psb_c_zvector *xh,
|
||||
psb_c_descriptor *cdh, psb_c_SolverOptions *opt);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
|
||||
@@ -21,17 +21,14 @@ contains
|
||||
!#define MLDC_ERR_FILTER(INFO) min(0,INFO)
|
||||
#define MLDC_ERR_FILTER(INFO) (INFO)
|
||||
#define MLDC_ERR_HANDLE(INFO) if(INFO/=amg_success_)MLDC_ERROR("ERROR!")
|
||||
|
||||
function amg_c_dprecinit(cctxt,ph,ptype) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(amg_c_dprec) :: ph
|
||||
type(psb_c_object_type), value :: cctxt
|
||||
character(c_char) :: ptype(*)
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
character(len=80) :: fptype
|
||||
|
||||
@@ -41,30 +38,28 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
allocate(precp,stat=info)
|
||||
if (info /= 0) return
|
||||
allocate(precp,stat=iret)
|
||||
if (iret /= 0) return
|
||||
|
||||
ph%item = c_loc(precp)
|
||||
|
||||
call stringc2f(ptype,fptype)
|
||||
call psb_stringc2f(ptype,fptype)
|
||||
|
||||
call precp%init(psb_c2f_ctxt(cctxt),fptype,info)
|
||||
call precp%init(psb_c2f_ctxt(cctxt),fptype,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecinit
|
||||
|
||||
function amg_c_dprecseti(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*)
|
||||
integer(psb_c_ipk_), value :: val
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
character(len=80) :: fwhat
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
|
||||
@@ -75,26 +70,24 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call psb_stringc2f(what,fwhat)
|
||||
|
||||
call precp%set(fwhat,val,info)
|
||||
call precp%set(fwhat,val,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecseti
|
||||
|
||||
|
||||
function amg_c_dprecsetr(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*)
|
||||
real(c_double), value :: val
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
character(len=80) :: fwhat
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
|
||||
@@ -105,24 +98,22 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call psb_stringc2f(what,fwhat)
|
||||
|
||||
call precp%set(fwhat,val,info)
|
||||
call precp%set(fwhat,val,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecsetr
|
||||
|
||||
function amg_c_dprecsetc(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*), val(*)
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
character(len=80) :: fwhat,fval
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
|
||||
@@ -133,28 +124,26 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call stringc2f(val,fval)
|
||||
call psb_stringc2f(what,fwhat)
|
||||
call psb_stringc2f(val,fval)
|
||||
|
||||
call precp%set(fwhat,fval,info)
|
||||
call precp%set(fwhat,fval,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecsetc
|
||||
|
||||
function amg_c_dprecbld(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer :: info
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
type(psb_dspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
character(len=80) :: fptype
|
||||
integer(psb_ipk_) :: iret
|
||||
|
||||
res = -1
|
||||
|
||||
@@ -174,22 +163,20 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call amg_precbld(ap,descp,precp,info)
|
||||
call amg_precbld(ap,descp,precp,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function amg_c_dprecbld
|
||||
|
||||
function amg_c_dhierarchy_build(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
type(psb_dspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
@@ -213,26 +200,24 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call precp%hierarchy_build(ap,descp,info)
|
||||
call precp%hierarchy_build(ap,descp,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function amg_c_dhierarchy_build
|
||||
|
||||
function amg_c_dsmoothers_build(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer :: info
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
type(psb_dspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
character(len=80) :: fptype
|
||||
integer(psb_ipk_) :: iret
|
||||
|
||||
res = -1
|
||||
|
||||
@@ -252,21 +237,135 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call precp%smoothers_build(ap,descp,info)
|
||||
call precp%smoothers_build(ap,descp,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function amg_c_dsmoothers_build
|
||||
|
||||
function amg_c_dsmoothers_build_opt(ah,cdh,ph,afmt,cdfmt) bind(c) result(res)
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
use psb_cuda_mod
|
||||
#endif
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
type(psb_dspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
character(c_char) :: afmt(*), cdfmt(*)
|
||||
character(len=80) :: fptype
|
||||
integer(psb_ipk_) :: iret
|
||||
! Local variables for formats
|
||||
character(len=10) :: fafmt, fcdfmt
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
type(psb_d_vect_cuda), target :: dvgpu
|
||||
type(psb_i_vect_cuda), target :: ivgpu
|
||||
! GPU matrix molds
|
||||
type(psb_d_cuda_hlg_sparse_mat), target :: ahlg
|
||||
type(psb_d_cuda_hdiag_sparse_mat), target :: ahdiag
|
||||
type(psb_d_cuda_csrg_sparse_mat), target :: acsrg
|
||||
type(psb_d_cuda_elg_sparse_mat), target :: aelg
|
||||
#endif
|
||||
type(psb_d_base_vect_type), target :: dvhost
|
||||
type(psb_i_base_vect_type), target :: ivhost
|
||||
! CPU matrix molds
|
||||
type(psb_d_ell_sparse_mat), target :: aell
|
||||
type(psb_d_csr_sparse_mat), target :: acsr
|
||||
type(psb_d_coo_sparse_mat), target :: acoo
|
||||
type(psb_d_hll_sparse_mat), target :: ahll
|
||||
type(psb_d_hdia_sparse_mat), target :: ahdia
|
||||
type(psb_d_dns_sparse_mat), target :: adns
|
||||
|
||||
! molding variables
|
||||
class(psb_d_base_vect_type), pointer :: vmold
|
||||
class(psb_d_base_sparse_mat), pointer :: amold
|
||||
class(psb_i_base_vect_type), pointer :: imold
|
||||
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Convert formats
|
||||
call psb_stringc2f(afmt,fafmt)
|
||||
call psb_stringc2f(cdfmt,fcdfmt)
|
||||
! Select matrix mold
|
||||
select case (psb_toupper(fafmt))
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
case('CSRG')
|
||||
amold => acsrg
|
||||
case('ELG')
|
||||
amold => aelg
|
||||
case('HLG')
|
||||
amold => ahlg
|
||||
case('HDIAG')
|
||||
amold => ahdiag
|
||||
#endif
|
||||
case('CSR')
|
||||
amold => acsr
|
||||
case('ELL')
|
||||
amold => aell
|
||||
case('COO')
|
||||
amold => acoo
|
||||
case('HLL')
|
||||
amold => ahll
|
||||
case('HDIA')
|
||||
amold => ahdia
|
||||
case('DNS')
|
||||
amold => adns
|
||||
case default
|
||||
write(psb_err_unit,'(A)') 'amg_c_dsmoothers_build_format: Unknown format ', fafmt, ' defaulting to CSR'
|
||||
amold => acsr
|
||||
end select
|
||||
! Select vector mold
|
||||
select case (psb_toupper(fcdfmt))
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
case('GPU','DEVICE')
|
||||
vmold => dvgpu
|
||||
imold => ivgpu
|
||||
#endif
|
||||
case('HOST','CPU')
|
||||
vmold => dvhost
|
||||
imold => ivhost
|
||||
case default
|
||||
write(psb_err_unit,'(A)') 'amg_c_dsmoothers_build_format: Unknown format ', fcdfmt, ' defaulting to HOST/CPU'
|
||||
vmold => dvhost
|
||||
imold => ivhost
|
||||
end select
|
||||
|
||||
|
||||
call precp%smoothers_build(ap,descp,iret,amold=amold,vmold=vmold,imold=imold)
|
||||
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function amg_c_dsmoothers_build_opt
|
||||
|
||||
function amg_c_dkrylov(methd,&
|
||||
& ah,ph,bh,xh,cdh,options) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_linsolve_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_dkrylov_cbind_mod
|
||||
use psb_dlinsolve_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ah,cdh,ph,bh,xh
|
||||
@@ -288,7 +387,6 @@ contains
|
||||
use psb_linsolve_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ah,cdh,ph,bh,xh
|
||||
@@ -302,7 +400,7 @@ contains
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
type(psb_d_vect_type), pointer :: xp, bp
|
||||
|
||||
integer :: info,fitmax,fitrace,first,fistop,fiter
|
||||
integer(psb_ipk_) :: iret,fitmax,fitrace,first,fistop,fiter
|
||||
character(len=20) :: fmethd
|
||||
real(kind(1.d0)) :: feps,ferr
|
||||
|
||||
@@ -334,7 +432,7 @@ contains
|
||||
end if
|
||||
|
||||
|
||||
call stringc2f(methd,fmethd)
|
||||
call psb_stringc2f(methd,fmethd)
|
||||
feps = eps
|
||||
fitmax = itmax
|
||||
fitrace = itrace
|
||||
@@ -342,23 +440,127 @@ contains
|
||||
fistop = istop
|
||||
|
||||
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
|
||||
& descp, info,&
|
||||
& descp, iret,&
|
||||
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
|
||||
& irst=first, err=ferr)
|
||||
iter = fiter
|
||||
err = ferr
|
||||
res = min(info,0)
|
||||
res = min(iret,0)
|
||||
|
||||
end function amg_c_dkrylov_opt
|
||||
|
||||
function amg_c_dprecfree(ph) bind(c) result(res)
|
||||
function amg_c_dprecapply(ph,bc,xc,cdh) bind(c,name="amg_c_dprecapply") result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
use psb_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph ! C handle to preconditioner
|
||||
type(psb_c_object_type) :: bc ! C handle to rhs
|
||||
type(psb_c_object_type) :: xc ! C handle to solution
|
||||
type(psb_c_object_type) :: cdh ! C handle to descriptor
|
||||
|
||||
! Fortran containers for preconditioner, lhs, rhs and descriptor
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
type(psb_d_vect_type), pointer :: xp, bp
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
res = -1
|
||||
! Check descriptor
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check rhs and solution
|
||||
if (c_associated(bc%item)) then
|
||||
call c_f_pointer(bc%item,bp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(xc%item)) then
|
||||
call c_f_pointer(xc%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check preconditioner
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Apply preconditioner
|
||||
call precp%apply(bp,xp,descp,info)
|
||||
|
||||
! Error handling and return
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecapply
|
||||
|
||||
function amg_c_dprecapply_opt(ph,bc,xc,cdh,ctrans) bind(c,name="amg_c_dprecapply_opt") result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph ! C handle to preconditioner
|
||||
type(psb_c_object_type) :: bc ! C handle to rhs
|
||||
type(psb_c_object_type) :: xc ! C handle to solution
|
||||
type(psb_c_object_type) :: cdh ! C handle to descriptor
|
||||
character(c_char) :: ctrans(*) ! Tranpose flag as character
|
||||
|
||||
! Fortran containers for preconditioner, lhs, rhs and descriptor
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
type(psb_d_vect_type), pointer :: xp, bp
|
||||
type(psb_desc_type), pointer :: descp
|
||||
character(len=10) :: ftrans
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
res = -1
|
||||
! Check descriptor
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check rhs and solution
|
||||
if (c_associated(bc%item)) then
|
||||
call c_f_pointer(bc%item,bp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(xc%item)) then
|
||||
call c_f_pointer(xc%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check preconditioner
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
! Convert transpose flag
|
||||
call psb_stringc2f(ctrans,ftrans)
|
||||
|
||||
! Apply preconditioner
|
||||
call precp%apply(bp,xp,descp,info,trans=ftrans)
|
||||
|
||||
! Error handling and return
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecapply_opt
|
||||
|
||||
function amg_c_dprecfree(ph) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
character(len=80) :: fptype
|
||||
|
||||
@@ -370,39 +572,88 @@ contains
|
||||
end if
|
||||
|
||||
|
||||
call precp%free(info)
|
||||
call precp%free(iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecfree
|
||||
|
||||
function amg_c_ddescr(ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
integer(psb_c_ipk_) :: info
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
integer(psb_c_ipk_) :: iret
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
|
||||
res = -1
|
||||
info = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
res = -1
|
||||
iret = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
call precp%descr(info)
|
||||
call flush(psb_out_unit)
|
||||
call precp%descr(iret)
|
||||
call flush(psb_out_unit)
|
||||
|
||||
info = 0
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_ddescr
|
||||
iret = 0
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_ddescr
|
||||
|
||||
function amg_c_dallocate_wrk(ph,chfmt) bind(c, name="amg_c_dallocate_wrk") result(res)
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
use psb_cuda_mod
|
||||
#endif
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: chfmt(*)
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
character(len=6) :: fchfmt
|
||||
! Local variable
|
||||
integer(psb_ipk_) :: info
|
||||
! Local mold variables
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
type(psb_d_vect_cuda), target :: dvgpu
|
||||
#endif
|
||||
type(psb_d_base_vect_type), target :: dvhost
|
||||
class(psb_d_base_vect_type), pointer :: vmold
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_stringc2f(chfmt,fchfmt)
|
||||
select case (psb_toupper(fchfmt))
|
||||
case('HOST','CPU')
|
||||
vmold => dvhost
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
case('GPU','DEVICE')
|
||||
vmold => dvgpu
|
||||
#endif
|
||||
case default
|
||||
write(psb_err_unit,'(A)') 'amg_c_dallocate_wrk: Unknown format ', fchfmt, ' defaulting to HOST/CPU'
|
||||
vmold => dvhost
|
||||
end select
|
||||
|
||||
call precp%allocate_wrk(info,vmold=vmold)
|
||||
|
||||
iret = info
|
||||
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
|
||||
end function amg_c_dallocate_wrk
|
||||
|
||||
end module amg_dprec_cbind_mod
|
||||
|
||||
@@ -23,15 +23,13 @@ contains
|
||||
#define MLDC_ERR_HANDLE(INFO) if(INFO/=amg_success_)MLDC_ERROR("ERROR!")
|
||||
|
||||
function amg_c_zprecinit(cctxt,ph,ptype) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(amg_c_zprec) :: ph
|
||||
type(psb_c_object_type), value :: cctxt
|
||||
character(c_char) :: ptype(*)
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
character(len=80) :: fptype
|
||||
|
||||
@@ -41,30 +39,28 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
allocate(precp,stat=info)
|
||||
if (info /= 0) return
|
||||
allocate(precp,stat=iret)
|
||||
if (iret /= 0) return
|
||||
|
||||
ph%item = c_loc(precp)
|
||||
|
||||
call stringc2f(ptype,fptype)
|
||||
call psb_stringc2f(ptype,fptype)
|
||||
|
||||
call precp%init(psb_c2f_ctxt(cctxt),fptype,info)
|
||||
call precp%init(psb_c2f_ctxt(cctxt),fptype,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecinit
|
||||
|
||||
function amg_c_zprecseti(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*)
|
||||
integer(psb_c_ipk_), value :: val
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
character(len=80) :: fwhat
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
|
||||
@@ -75,26 +71,24 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call psb_stringc2f(what,fwhat)
|
||||
|
||||
call precp%set(fwhat,val,info)
|
||||
call precp%set(fwhat,val,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecseti
|
||||
|
||||
|
||||
function amg_c_zprecsetr(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*)
|
||||
real(c_double), value :: val
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
character(len=80) :: fwhat
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
|
||||
@@ -105,24 +99,22 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call psb_stringc2f(what,fwhat)
|
||||
|
||||
call precp%set(fwhat,val,info)
|
||||
call precp%set(fwhat,val,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecsetr
|
||||
|
||||
function amg_c_zprecsetc(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*), val(*)
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
character(len=80) :: fwhat,fval
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
|
||||
@@ -133,24 +125,22 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call stringc2f(val,fval)
|
||||
call psb_stringc2f(what,fwhat)
|
||||
call psb_stringc2f(val,fval)
|
||||
|
||||
call precp%set(fwhat,fval,info)
|
||||
call precp%set(fwhat,fval,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecsetc
|
||||
|
||||
function amg_c_zprecbld(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
@@ -174,22 +164,20 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call amg_precbld(ap,descp,precp,info)
|
||||
call amg_precbld(ap,descp,precp,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function amg_c_zprecbld
|
||||
|
||||
function amg_c_zhierarchy_build(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
@@ -213,22 +201,20 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call precp%hierarchy_build(ap,descp,info)
|
||||
call precp%hierarchy_build(ap,descp,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function amg_c_zhierarchy_build
|
||||
|
||||
function amg_c_zsmoothers_build(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
@@ -252,21 +238,127 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call precp%smoothers_build(ap,descp,info)
|
||||
call precp%smoothers_build(ap,descp,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function amg_c_zsmoothers_build
|
||||
|
||||
function amg_c_zsmoothers_build_format(ah,cdh,ph,afmt,cdfmt) bind(c) result(res)
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
use psb_cuda_mod
|
||||
#endif
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
character(c_char) :: afmt(*), cdfmt(*)
|
||||
character(len=80) :: fptype
|
||||
integer(psb_ipk_) :: iret
|
||||
! Local variables for formats
|
||||
character(len=10) :: fafmt, fcdfmt
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
type(psb_z_vect_cuda), target :: dvgpu
|
||||
type(psb_i_vect_cuda), target :: ivgpu
|
||||
! GPU matrix molds
|
||||
type(psb_z_cuda_hlg_sparse_mat), target :: ahlg
|
||||
type(psb_z_cuda_csrg_sparse_mat), target :: acsrg
|
||||
type(psb_z_cuda_elg_sparse_mat), target :: aelg
|
||||
#endif
|
||||
type(psb_z_base_vect_type), target :: dvhost
|
||||
type(psb_i_base_vect_type), target :: ivhost
|
||||
! CPU matrix molds
|
||||
type(psb_z_ell_sparse_mat), target :: aell
|
||||
type(psb_z_csr_sparse_mat), target :: acsr
|
||||
type(psb_z_coo_sparse_mat), target :: acoo
|
||||
type(psb_z_hll_sparse_mat), target :: ahll
|
||||
type(psb_z_dns_sparse_mat), target :: adns
|
||||
|
||||
! molding variables
|
||||
class(psb_z_base_vect_type), pointer :: vmold
|
||||
class(psb_z_base_sparse_mat), pointer :: amold
|
||||
class(psb_i_base_vect_type), pointer :: imold
|
||||
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Convert formats
|
||||
call psb_stringc2f(afmt,fafmt)
|
||||
call psb_stringc2f(cdfmt,fcdfmt)
|
||||
! Select matrix mold
|
||||
select case (psb_toupper(fafmt))
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
case('CSRG')
|
||||
amold => acsrg
|
||||
case('ELG')
|
||||
amold => aelg
|
||||
case('HLG')
|
||||
amold => ahlg
|
||||
#endif
|
||||
case('CSR')
|
||||
amold => acsr
|
||||
case('ELL')
|
||||
amold => aell
|
||||
case('COO')
|
||||
amold => acoo
|
||||
case('HLL')
|
||||
amold => ahll
|
||||
case('DNS')
|
||||
amold => adns
|
||||
case default
|
||||
write(psb_err_unit,'(A)') 'amg_c_zsmoothers_build_format: Unknown format ', fafmt, ' defaulting to CSR'
|
||||
amold => acsr
|
||||
end select
|
||||
! Select vector mold
|
||||
select case (psb_toupper(fcdfmt))
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
case('GPU','DEVICE')
|
||||
vmold => dvgpu
|
||||
imold => ivgpu
|
||||
#endif
|
||||
case('HOST','CPU')
|
||||
vmold => dvhost
|
||||
imold => ivhost
|
||||
case default
|
||||
write(psb_err_unit,'(A)') 'amg_c_zsmoothers_build_format: Unknown format ', fcdfmt, ' defaulting to HOST/CPU'
|
||||
vmold => dvhost
|
||||
imold => ivhost
|
||||
end select
|
||||
|
||||
|
||||
call precp%smoothers_build(ap,descp,iret,amold=amold,vmold=vmold,imold=imold)
|
||||
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function amg_c_zsmoothers_build_format
|
||||
|
||||
function amg_c_zkrylov(methd,&
|
||||
& ah,ph,bh,xh,cdh,options) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_linsolve_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_zkrylov_cbind_mod
|
||||
use psb_zlinsolve_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ah,cdh,ph,bh,xh
|
||||
@@ -283,12 +375,8 @@ contains
|
||||
|
||||
function amg_c_zkrylov_opt(methd,&
|
||||
& ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_linsolve_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ah,cdh,ph,bh,xh
|
||||
@@ -302,7 +390,7 @@ contains
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
type(psb_z_vect_type), pointer :: xp, bp
|
||||
|
||||
integer :: info,fitmax,fitrace,first,fistop,fiter
|
||||
integer(psb_ipk_) :: iret,fitmax,fitrace,first,fistop,fiter
|
||||
character(len=20) :: fmethd
|
||||
real(kind(1.d0)) :: feps,ferr
|
||||
|
||||
@@ -334,7 +422,7 @@ contains
|
||||
end if
|
||||
|
||||
|
||||
call stringc2f(methd,fmethd)
|
||||
call psb_stringc2f(methd,fmethd)
|
||||
feps = eps
|
||||
fitmax = itmax
|
||||
fitrace = itrace
|
||||
@@ -342,23 +430,127 @@ contains
|
||||
fistop = istop
|
||||
|
||||
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
|
||||
& descp, info,&
|
||||
& descp, iret,&
|
||||
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
|
||||
& irst=first, err=ferr)
|
||||
iter = fiter
|
||||
err = ferr
|
||||
res = min(info,0)
|
||||
res = min(iret,0)
|
||||
|
||||
end function amg_c_zkrylov_opt
|
||||
|
||||
function amg_c_zprecfree(ph) bind(c) result(res)
|
||||
function amg_c_zprecapply(ph,bc,xc,cdh) bind(c,name="amg_c_zprecapply") result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
use psb_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph ! C handle to preconditioner
|
||||
type(psb_c_object_type) :: bc ! C handle to rhs
|
||||
type(psb_c_object_type) :: xc ! C handle to solution
|
||||
type(psb_c_object_type) :: cdh ! C handle to descriptor
|
||||
|
||||
! Fortran containers for preconditioner, lhs, rhs and descriptor
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
type(psb_z_vect_type), pointer :: xp, bp
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
res = -1
|
||||
! Check descriptor
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check rhs and solution
|
||||
if (c_associated(bc%item)) then
|
||||
call c_f_pointer(bc%item,bp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(xc%item)) then
|
||||
call c_f_pointer(xc%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check preconditioner
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Apply preconditioner
|
||||
call precp%apply(bp,xp,descp,info)
|
||||
|
||||
! Error handling and return
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecapply
|
||||
|
||||
function amg_c_zprecapply_opt(ph,bc,xc,cdh,ctrans) bind(c,name="amg_c_zprecapply_opt") result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph ! C handle to preconditioner
|
||||
type(psb_c_object_type) :: bc ! C handle to rhs
|
||||
type(psb_c_object_type) :: xc ! C handle to solution
|
||||
type(psb_c_object_type) :: cdh ! C handle to descriptor
|
||||
character(c_char) :: ctrans(:) ! Tranpose flag as character
|
||||
|
||||
! Fortran containers for preconditioner, lhs, rhs and descriptor
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
type(psb_z_vect_type), pointer :: xp, bp
|
||||
type(psb_desc_type), pointer :: descp
|
||||
character(len=10) :: ftrans
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
res = -1
|
||||
! Check descriptor
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check rhs and solution
|
||||
if (c_associated(bc%item)) then
|
||||
call c_f_pointer(bc%item,bp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(xc%item)) then
|
||||
call c_f_pointer(xc%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check preconditioner
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
! Convert transpose flag
|
||||
call psb_stringc2f(ctrans,ftrans)
|
||||
|
||||
! Apply preconditioner
|
||||
call precp%apply(bp,xp,descp,info,trans=ftrans)
|
||||
|
||||
! Error handling and return
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecapply_opt
|
||||
|
||||
function amg_c_zprecfree(ph) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
integer :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
character(len=80) :: fptype
|
||||
|
||||
@@ -370,25 +562,23 @@ contains
|
||||
end if
|
||||
|
||||
|
||||
call precp%free(info)
|
||||
call precp%free(iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecfree
|
||||
|
||||
function amg_c_zdescr(ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
integer(psb_c_ipk_) :: info
|
||||
integer(psb_c_ipk_) :: iret
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
|
||||
res = -1
|
||||
info = -1
|
||||
iret = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
@@ -396,13 +586,64 @@ contains
|
||||
end if
|
||||
|
||||
|
||||
call precp%descr(info)
|
||||
call precp%descr(iret)
|
||||
call flush(psb_out_unit)
|
||||
|
||||
info = 0
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
iret = 0
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zdescr
|
||||
|
||||
function amg_c_zallocate_wrk(ph,chfmt) bind(c, name="amg_c_zallocate_wrk") result(res)
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
use psb_cuda_mod
|
||||
#endif
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: chfmt(*)
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
character(len=6) :: fchfmt
|
||||
! Local variable
|
||||
integer(psb_ipk_) :: info
|
||||
! Local mold variables
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
type(psb_z_vect_cuda), target :: zvgpu
|
||||
#endif
|
||||
type(psb_z_base_vect_type), target :: zvhost
|
||||
class(psb_z_base_vect_type), pointer :: vmold
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_stringc2f(chfmt,fchfmt)
|
||||
select case (psb_toupper(fchfmt))
|
||||
case('HOST','CPU')
|
||||
vmold => zvhost
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
case('GPU','DEVICE')
|
||||
vmold => zvgpu
|
||||
#endif
|
||||
case default
|
||||
write(psb_err_unit,'(A)') 'amg_c_zallocate_wrk: Unknown format ', fchfmt, ' defaulting to HOST/CPU'
|
||||
vmold => zvhost
|
||||
end select
|
||||
|
||||
call precp%allocate_wrk(info,vmold=vmold)
|
||||
|
||||
iret = info
|
||||
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
|
||||
end function amg_c_zallocate_wrk
|
||||
|
||||
end module amg_zprec_cbind_mod
|
||||
|
||||
@@ -8,7 +8,7 @@ HERE=.
|
||||
|
||||
FINCLUDES=$(FMFLAG). $(FMFLAG)$(LIBDIR) $(FMFLAG)$(PSBLAS_INCDIR)
|
||||
#PSBLAS_LIBS= -L$(PSBLAS_LIBDIR) -L$(LIBDIR) $(CPSBLAS_LIB) $(PSBLAS_LIB)
|
||||
# -lpsb_krylov_cbind -lpsb_prec_cbind -lpsb_base_cbind
|
||||
# -lpsb_linsolve_cbind -lpsb_prec_cbind -lpsb_base_cbind
|
||||
PSBC_LIBS= -L$(PSBLAS_LIBDIR) -lpsb_cbind -lpsb_linsolve -lpsb_prec
|
||||
AMGC_LIBS=-L$(LIBDIR) -lamg_cbind -lamg_prec
|
||||
#
|
||||
@@ -23,16 +23,21 @@ EXEDIR=./runs
|
||||
#UMFLIBS=-lumfpack -lamd -lcholmod -lcolamd -lcamd -lccolamd -L/usr/include/suitesparse
|
||||
#UMFFLAGS=-DHave_UMF_ -I/usr/include/suitesparse
|
||||
|
||||
all: amgec
|
||||
all: amgec amgecgpu
|
||||
|
||||
amgec: amgec.o
|
||||
$(MPFC) amgec.o -o amgec $(AMGC_LIBS) $(PSBC_LIBS) $(PSBCLDLIBS) $(PSBLAS_LIBS) \
|
||||
$(UMFLIBS) $(PSBLDLIBS) $(LDLIBS) -lm -lgfortran
|
||||
$(UMFLIBS) $(PSBLDLIBS) $(AMGLDLIBS) $(PSBGPULDLIBS) $(LDLIBS) -lm -lgfortran -fopenmp
|
||||
# \
|
||||
# -lifcore -lifcoremt -lguide -limf -lirc -lintlc -lcxaguard -L/opt/intel/fc/10.0.023/lib/ -lm
|
||||
|
||||
/bin/mv amgec $(EXEDIR)
|
||||
|
||||
amgecgpu: amgecgpu.o
|
||||
$(MPFC) amgecgpu.o -o amgecgpu $(AMGC_LIBS) $(PSBC_LIBS) $(PSBCLDLIBS) $(PSBLAS_LIBS) \
|
||||
$(UMFLIBS) $(PSBLDLIBS) $(AMGLDLIBS) $(PSBGPULDLIBS) $(LDLIBS) -lm -lgfortran -fopenmp
|
||||
/bin/mv amgecgpu $(EXEDIR)
|
||||
|
||||
.f90.o:
|
||||
$(MPFC) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.c.o:
|
||||
@@ -40,7 +45,7 @@ amgec: amgec.o
|
||||
|
||||
|
||||
clean:
|
||||
/bin/rm -f amgec.o $(EXEDIR)/amgec
|
||||
/bin/rm -f amgec.o $(EXEDIR)/amgec $(EXEDIR)/amgecgpu
|
||||
verycleanlib:
|
||||
(cd ../..; make veryclean)
|
||||
lib:
|
||||
@@ -48,5 +53,6 @@ lib:
|
||||
|
||||
tests: all
|
||||
cd runs ; ./amgec < amge.inp
|
||||
cd runs ; ./amgecgpu < amgegpu.inp
|
||||
|
||||
|
||||
|
||||
@@ -358,6 +358,25 @@ int main(int argc, char *argv[])
|
||||
fprintf(stderr,"From smoothers_build: %d\n",ret);
|
||||
|
||||
psb_c_barrier(*cctxt);
|
||||
/* Do a dry run of the preconditioner */
|
||||
info = amg_c_dprecapply(ph,bh,xh,cdh);
|
||||
if (info != 0) {
|
||||
fprintf(stderr,"From dprec_apply: %d\nBailing out\n",info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
/* Do a dry run of the preconditioner with the option routine */
|
||||
info = amg_c_dprecapply_opt(ph,bh,xh,cdh,"N");
|
||||
if (info != 0) {
|
||||
fprintf(stderr,"From dprec_apply_opt: %d\nBailing out\n",info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
/*
|
||||
info = amg_c_dprecapply_opt(ph,bh,xh,cdh,"T");
|
||||
if (info != 0) {
|
||||
fprintf(stderr,"From dprec_apply_opt: %d\nBailing out\n",info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
*/
|
||||
/* Set up the solver options */
|
||||
psb_c_DefaultSolverOptions(&options);
|
||||
options.eps = 1.e-6;
|
||||
|
||||
@@ -0,0 +1,679 @@
|
||||
/*----------------------------------------------------------------------------------*/
|
||||
/* Parallel Sparse BLAS v2.2 */
|
||||
/* (C) Copyright 2007 Salvatore Filippone University of Rome Tor Vergata */
|
||||
/* */
|
||||
/* Redistribution and use in source and binary forms, with or without */
|
||||
/* modification, are permitted provided that the following conditions */
|
||||
/* 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 PSBLAS 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 PSBLAS 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: ppdec.c */
|
||||
/* */
|
||||
/* Program: ppdec */
|
||||
/* This sample program shows how to build and solve a sparse linear */
|
||||
/* */
|
||||
/* The program solves a linear system based on the partial differential */
|
||||
/* equation */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* The equation generated is */
|
||||
/* */
|
||||
/* b1 d d (u) b2 d d (u) a1 d (u)) a2 d (u))) */
|
||||
/* - ------ - ------ + ----- + ------ + a3 u = 0 */
|
||||
/* dx dx dy dy dx dy */
|
||||
/* */
|
||||
/* */
|
||||
/* with Dirichlet boundary conditions on the unit cube */
|
||||
/* */
|
||||
/* 0<=x,y,z<=1 */
|
||||
/* */
|
||||
/* The equation is discretized with finite differences and uniform stepsize; */
|
||||
/* the resulting discrete equation is */
|
||||
/* */
|
||||
/* ( u(x,y,z)(2b1+2b2+a1+a2)+u(x-1,y)(-b1-a1)+u(x,y-1)(-b2-a2)+ */
|
||||
/* -u(x+1,y)b1-u(x,y+1)b2)*(1/h**2) */
|
||||
/* */
|
||||
/* Example adapted from: C.T.Kelley */
|
||||
/* Iterative Methods for Linear and Nonlinear Equations */
|
||||
/* SIAM 1995 */
|
||||
/* */
|
||||
/* */
|
||||
/* In this sample program the index space of the discretized */
|
||||
/* computational domain is first numbered sequentially in a standard way, */
|
||||
/* then the corresponding vector is distributed according to an HPF BLOCK */
|
||||
/* distribution directive. */
|
||||
/* */
|
||||
/* Boundary conditions are set in a very simple way, by adding */
|
||||
/* equations of the form */
|
||||
/* */
|
||||
/* u(x,y) = rhs(x,y) */
|
||||
/* */
|
||||
/*----------------------------------------------------------------------------------*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <math.h>
|
||||
|
||||
#include "psb_base_cbind.h"
|
||||
#include "amg_cbind.h"
|
||||
|
||||
double a1(double x, double y, double z)
|
||||
{
|
||||
return (1.0 / 80.0);
|
||||
}
|
||||
double a2(double x, double y, double z)
|
||||
{
|
||||
return (1.0 / 80.0);
|
||||
}
|
||||
double a3(double x, double y, double z)
|
||||
{
|
||||
return (1.0 / 80.0);
|
||||
}
|
||||
double c(double x, double y, double z)
|
||||
{
|
||||
return (0.0);
|
||||
}
|
||||
double b1(double x, double y, double z)
|
||||
{
|
||||
return (0.0 / sqrt(3.0));
|
||||
}
|
||||
double b2(double x, double y, double z)
|
||||
{
|
||||
return (0.0 / sqrt(3.0));
|
||||
}
|
||||
double b3(double x, double y, double z)
|
||||
{
|
||||
return (0.0 / sqrt(3.0));
|
||||
}
|
||||
|
||||
double g(double x, double y, double z)
|
||||
{
|
||||
if (x == 1.0)
|
||||
{
|
||||
return (1.0);
|
||||
}
|
||||
else if (x == 0.0)
|
||||
{
|
||||
return (exp(-y * y - z * z));
|
||||
}
|
||||
else
|
||||
{
|
||||
return (0.0);
|
||||
}
|
||||
}
|
||||
|
||||
#define NBMAX 20
|
||||
|
||||
psb_i_t matgen(psb_c_ctxt cctxt, psb_i_t nl, psb_i_t idim, psb_l_t vl[],
|
||||
psb_c_dspmat *ah, const char *afmt,
|
||||
psb_c_descriptor *cdh, const char *cdfmt,
|
||||
psb_c_dvector *xh, psb_c_dvector *bh, psb_c_dvector *rh)
|
||||
{
|
||||
psb_i_t iam, np;
|
||||
psb_l_t ix, iy, iz, el, glob_row;
|
||||
psb_i_t i, k, info, ret;
|
||||
double x, y, z, deltah, sqdeltah, deltah2;
|
||||
double val[10 * NBMAX], zt[NBMAX];
|
||||
psb_l_t irow[10 * NBMAX], icol[10 * NBMAX];
|
||||
|
||||
info = 0;
|
||||
psb_c_info(cctxt, &iam, &np);
|
||||
|
||||
if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Starting matrix generation: local number of rows %d\n", nl);
|
||||
fprintf(stdout, "Matrix format: %s\n", afmt);
|
||||
fprintf(stdout, "Descriptor format: %s\n", cdfmt);
|
||||
fflush(stdout);
|
||||
}
|
||||
fprintf(stderr, "Matrix generation: local number of rows %d on process %d\n", nl, iam);
|
||||
|
||||
deltah = (double)1.0 / (idim + 1);
|
||||
sqdeltah = deltah * deltah;
|
||||
deltah2 = 2.0 * deltah;
|
||||
psb_c_set_index_base(0);
|
||||
for (i = 0; i < nl; i++)
|
||||
{
|
||||
glob_row = vl[i];
|
||||
// if ((i%100000 == 0)||(i<10)) fprintf(stderr,"%d: generation loop at %d %ld \n",iam,i,glob_row);
|
||||
el = 0;
|
||||
ix = glob_row / (idim * idim);
|
||||
iy = (glob_row - ix * idim * idim) / idim;
|
||||
iz = glob_row - ix * idim * idim - iy * idim;
|
||||
x = (ix + 1) * deltah;
|
||||
y = (iy + 1) * deltah;
|
||||
z = (iz + 1) * deltah;
|
||||
zt[0] = 0.0;
|
||||
/* internal point: build discretization */
|
||||
/* term depending on (x-1,y,z) */
|
||||
val[el] = -a1(x, y, z) / sqdeltah - b1(x, y, z) / deltah2;
|
||||
if (ix == 0)
|
||||
{
|
||||
zt[0] += g(0.0, y, z) * (-val[el]);
|
||||
}
|
||||
else
|
||||
{
|
||||
icol[el] = (ix - 1) * idim * idim + (iy)*idim + (iz);
|
||||
el = el + 1;
|
||||
}
|
||||
/* term depending on (x,y-1,z) */
|
||||
val[el] = -a2(x, y, z) / sqdeltah - b2(x, y, z) / deltah2;
|
||||
if (iy == 0)
|
||||
{
|
||||
zt[0] += g(x, 0.0, z) * (-val[el]);
|
||||
}
|
||||
else
|
||||
{
|
||||
icol[el] = (ix)*idim * idim + (iy - 1) * idim + (iz);
|
||||
el = el + 1;
|
||||
}
|
||||
/* term depending on (x,y,z-1)*/
|
||||
val[el] = -a3(x, y, z) / sqdeltah - b3(x, y, z) / deltah2;
|
||||
if (iz == 0)
|
||||
{
|
||||
zt[0] += g(x, y, 0.0) * (-val[el]);
|
||||
}
|
||||
else
|
||||
{
|
||||
icol[el] = (ix)*idim * idim + (iy)*idim + (iz - 1);
|
||||
el = el + 1;
|
||||
}
|
||||
/* term depending on (x,y,z)*/
|
||||
val[el] = 2.0 * (a1(x, y, z) + a2(x, y, z) + a3(x, y, z)) / sqdeltah + c(x, y, z);
|
||||
icol[el] = (ix)*idim * idim + (iy)*idim + (iz);
|
||||
el = el + 1;
|
||||
/* term depending on (x,y,z+1) */
|
||||
val[el] = -a3(x, y, z) / sqdeltah + b3(x, y, z) / deltah2;
|
||||
if (iz == idim - 1)
|
||||
{
|
||||
zt[0] += g(x, y, 1.0) * (-val[el]);
|
||||
}
|
||||
else
|
||||
{
|
||||
icol[el] = (ix)*idim * idim + (iy)*idim + (iz + 1);
|
||||
el = el + 1;
|
||||
}
|
||||
/* term depending on (x,y+1,z) */
|
||||
val[el] = -a2(x, y, z) / sqdeltah + b2(x, y, z) / deltah2;
|
||||
if (iy == idim - 1)
|
||||
{
|
||||
zt[0] += g(x, 1.0, z) * (-val[el]);
|
||||
}
|
||||
else
|
||||
{
|
||||
icol[el] = (ix)*idim * idim + (iy + 1) * idim + (iz);
|
||||
el = el + 1;
|
||||
}
|
||||
/* term depending on (x+1,y,z) */
|
||||
val[el] = -a1(x, y, z) / sqdeltah + b1(x, y, z) / deltah2;
|
||||
if (ix == idim - 1)
|
||||
{
|
||||
zt[0] += g(1.0, y, z) * (-val[el]);
|
||||
}
|
||||
else
|
||||
{
|
||||
icol[el] = (ix + 1) * idim * idim + (iy)*idim + (iz);
|
||||
el = el + 1;
|
||||
}
|
||||
for (k = 0; k < el; k++)
|
||||
irow[k] = glob_row;
|
||||
if ((ret = psb_c_dspins(el, irow, icol, val, ah, cdh)) != 0)
|
||||
fprintf(stderr, "From psb_c_dspins: %d\n", ret);
|
||||
irow[0] = glob_row;
|
||||
psb_c_dgeins(1, irow, zt, bh, cdh);
|
||||
zt[0] = 0.0;
|
||||
psb_c_dgeins(1, irow, zt, xh, cdh);
|
||||
}
|
||||
|
||||
#ifdef PSB_HAVE_CUDA
|
||||
/* Execute assembly and final allocation on CUDA device */
|
||||
info = psb_c_cdasb_format(cdh, cdfmt);
|
||||
if (info != 0)
|
||||
{
|
||||
return (info);
|
||||
}
|
||||
#ifdef DEBUG
|
||||
else if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Completed descriptor assembly format\n");
|
||||
fflush(stdout);
|
||||
}
|
||||
#endif
|
||||
info = psb_c_dspasb_opt(ah, cdh, afmt, PSB_UPD_DFLT, PSB_DUPL_DEF);
|
||||
if (info != 0)
|
||||
{
|
||||
return (info);
|
||||
}
|
||||
#ifdef DEBUG
|
||||
else if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Completed matrix assembly\n");
|
||||
fflush(stdout);
|
||||
}
|
||||
#endif
|
||||
info = psb_c_dgeasb_options_format(xh, cdh, PSB_DUPL_ADD, cdfmt);
|
||||
if (info != 0)
|
||||
{
|
||||
return (info);
|
||||
}
|
||||
#ifdef DEBUG
|
||||
else if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Completed x vector assembly\n");
|
||||
fflush(stdout);
|
||||
}
|
||||
#endif
|
||||
info = psb_c_dgeasb_options_format(bh, cdh, PSB_DUPL_ADD, cdfmt);
|
||||
if (info != 0)
|
||||
{
|
||||
return (info);
|
||||
}
|
||||
#ifdef DEBUG
|
||||
else if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Completed b vector assembly\n");
|
||||
fflush(stdout);
|
||||
}
|
||||
#endif
|
||||
info = psb_c_dgeasb_options_format(rh, cdh, PSB_DUPL_ADD, cdfmt);
|
||||
if (info != 0)
|
||||
{
|
||||
return (info);
|
||||
}
|
||||
#ifdef DEBUG
|
||||
else if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Completed r vector assembly\n");
|
||||
fflush(stdout);
|
||||
}
|
||||
#endif
|
||||
#else
|
||||
/* Execute assembly and final allocation HOST side */
|
||||
if ((info = psb_c_cdasb(cdh)) != 0)
|
||||
return (info);
|
||||
|
||||
if ((info = psb_c_dspasb(ah, cdh)) != 0)
|
||||
return (info);
|
||||
|
||||
if ((info = psb_c_dgeasb(xh, cdh)) != 0)
|
||||
return (info);
|
||||
if ((info = psb_c_dgeasb(bh, cdh)) != 0)
|
||||
return (info);
|
||||
if ((info = psb_c_dgeasb(rh, cdh)) != 0)
|
||||
return (info);
|
||||
return (info);
|
||||
#endif
|
||||
}
|
||||
|
||||
#define LINEBUFSIZE 1024
|
||||
static char buffer[LINEBUFSIZE + 1];
|
||||
int get_buffer(FILE *fp)
|
||||
{
|
||||
while (!feof(fp))
|
||||
{
|
||||
fgets(buffer, LINEBUFSIZE, fp);
|
||||
if (buffer[0] != '%')
|
||||
break;
|
||||
}
|
||||
}
|
||||
void get_iparm(FILE *fp, int *val)
|
||||
{
|
||||
get_buffer(fp);
|
||||
// fprintf(stderr,"Reading int parm: %s\n",buffer);
|
||||
sscanf(buffer, "%d ", val);
|
||||
}
|
||||
void get_dparm(FILE *fp, double *val)
|
||||
{
|
||||
get_buffer(fp);
|
||||
sscanf(buffer, "%lf ", val);
|
||||
}
|
||||
void get_hparm(FILE *fp, char *val)
|
||||
{
|
||||
get_buffer(fp);
|
||||
sscanf(buffer, "%s ", val);
|
||||
}
|
||||
|
||||
#define DUMPMATRIX 0
|
||||
|
||||
int main(int argc, char *argv[])
|
||||
{
|
||||
psb_c_ctxt *cctxt;
|
||||
psb_i_t iam, np;
|
||||
char methd[40], ptype[40], afmt[8], cdfmt[8];
|
||||
psb_i_t nparms;
|
||||
psb_i_t idim, info, istop, itmax, itrace, irst, iter, ret;
|
||||
amg_c_dprec *ph;
|
||||
psb_c_dspmat *ah;
|
||||
psb_c_dvector *bh, *xh, *rh;
|
||||
psb_i_t nb, nlr, nl;
|
||||
psb_l_t i, ng, *vl, k;
|
||||
double t1, t2, eps, err;
|
||||
double *xv, *bv, *rv;
|
||||
double one = 1.0, zero = 0.0, res2;
|
||||
psb_c_SolverOptions options;
|
||||
psb_c_descriptor *cdh;
|
||||
FILE *vectfile;
|
||||
|
||||
cctxt = psb_c_new_ctxt();
|
||||
psb_c_init(cctxt);
|
||||
#ifdef PSB_HAVE_CUDA
|
||||
psb_c_cuda_init(cctxt);
|
||||
#endif
|
||||
psb_c_info(*cctxt, &iam, &np);
|
||||
#ifdef PSB_HAVE_CUDA
|
||||
if (iam == 0)
|
||||
{
|
||||
fprintf(stderr, "-- CUDA initialized --\n");
|
||||
fprintf(stderr, "Number of available GPU devices: %d\n", psb_c_cuda_getDeviceCount());
|
||||
}
|
||||
#endif
|
||||
fprintf(stdout, "Initialization: am %d of %d\n", iam, np);
|
||||
|
||||
fflush(stdout);
|
||||
psb_c_barrier(*cctxt);
|
||||
if (iam == 0)
|
||||
{
|
||||
get_iparm(stdin, &nparms);
|
||||
get_hparm(stdin, methd);
|
||||
get_hparm(stdin, ptype);
|
||||
get_hparm(stdin, afmt);
|
||||
get_hparm(stdin, cdfmt);
|
||||
get_iparm(stdin, &idim);
|
||||
get_iparm(stdin, &istop);
|
||||
get_iparm(stdin, &itmax);
|
||||
get_iparm(stdin, &itrace);
|
||||
get_iparm(stdin, &irst);
|
||||
|
||||
#if 0
|
||||
/* Display paremeters */
|
||||
fprintf(stderr, "Input parameters:\n");
|
||||
fprintf(stderr, " Number of parameters: %d\n", nparms);
|
||||
fprintf(stderr, " Method: %s\n", methd);
|
||||
fprintf(stderr, " Preconditioner type: %s\n", ptype);
|
||||
fprintf(stderr, " Matrix format: %s\n", afmt);
|
||||
fprintf(stderr, " Descriptor format: %s\n", cdfmt);
|
||||
fprintf(stderr, " Problem dimension: %d\n", idim);
|
||||
fprintf(stderr, " Stopping criterion: %d\n", istop);
|
||||
fprintf(stderr, " Maximum iterations: %d\n", itmax);
|
||||
fprintf(stderr, " Trace frequency: %d\n", itrace);
|
||||
fprintf(stderr, " Restart depth: %d\n", irst);
|
||||
#endif
|
||||
}
|
||||
/* Now broadcast the values, and check they're OK */
|
||||
psb_c_ibcast(*cctxt, 1, &nparms, 0);
|
||||
psb_c_hbcast(*cctxt, methd, 0);
|
||||
psb_c_hbcast(*cctxt, ptype, 0);
|
||||
psb_c_hbcast(*cctxt, afmt, 0);
|
||||
psb_c_hbcast(*cctxt, cdfmt, 0);
|
||||
psb_c_ibcast(*cctxt, 1, &idim, 0);
|
||||
psb_c_ibcast(*cctxt, 1, &istop, 0);
|
||||
psb_c_ibcast(*cctxt, 1, &itmax, 0);
|
||||
psb_c_ibcast(*cctxt, 1, &itrace, 0);
|
||||
psb_c_ibcast(*cctxt, 1, &irst, 0);
|
||||
|
||||
psb_c_barrier(*cctxt);
|
||||
|
||||
cdh = psb_c_new_descriptor();
|
||||
psb_c_set_index_base(0);
|
||||
|
||||
/* Simple minded BLOCK data distribution */
|
||||
ng = ((psb_l_t)idim) * idim * idim;
|
||||
nb = (ng + np - 1) / np;
|
||||
nl = nb;
|
||||
if ((ng - iam * nb) < nl)
|
||||
nl = ng - iam * nb;
|
||||
fprintf(stderr, "%d: Input data %d %ld %d %d\n", iam, idim, ng, nb, nl);
|
||||
if ((vl = malloc(nb * sizeof(psb_l_t))) == NULL)
|
||||
{
|
||||
fprintf(stderr, "On %d: malloc failure\n", iam);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
i = ((psb_l_t)iam) * nb;
|
||||
for (k = 0; k < nl; k++)
|
||||
vl[k] = i + k;
|
||||
|
||||
if ((info = psb_c_cdall_vl(nl, vl, *cctxt, cdh)) != 0)
|
||||
{
|
||||
fprintf(stderr, "From cdall: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
|
||||
bh = psb_c_new_dvector();
|
||||
xh = psb_c_new_dvector();
|
||||
rh = psb_c_new_dvector();
|
||||
ah = psb_c_new_dspmat();
|
||||
// fprintf(stderr,"From psb_c_new_dspmat: %p\n",ah);
|
||||
|
||||
/* Allocate mem space for sparse matrix and vectors */
|
||||
ret = psb_c_dspall(ah, cdh);
|
||||
// fprintf(stderr,"From psb_c_dspall: %d\n",ret);
|
||||
psb_c_dgeall(bh, cdh);
|
||||
psb_c_dgeall(xh, cdh);
|
||||
psb_c_dgeall(rh, cdh);
|
||||
|
||||
if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Matrix and vectors allocated\n");
|
||||
}
|
||||
psb_c_barrier(*cctxt);
|
||||
|
||||
/* Matrix generation */
|
||||
if (matgen(*cctxt, nl, idim, vl, ah, afmt, cdh, cdfmt, xh, bh, rh) != 0)
|
||||
{
|
||||
fprintf(stderr, "Error during matrix build loop\n");
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
psb_c_barrier(*cctxt);
|
||||
#if 0
|
||||
if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Matrix and vectors generated\n");
|
||||
}
|
||||
#endif
|
||||
fflush(stdout);
|
||||
/* Set up the preconditioner */
|
||||
ph = amg_c_dprec_new();
|
||||
amg_c_dprecinit(*cctxt, ph, ptype);
|
||||
amg_c_dprecsetc(ph, "SMOOTHER_TYPE", "L1-JACOBI");
|
||||
amg_c_dprecseti(ph, "SMOOTHER_SWEEPS", 2);
|
||||
amg_c_dprecsetc(ph, "COARSE_SOLVE", "BJAC");
|
||||
amg_c_dprecsetc(ph, "COARSE_SUBSOLVE", "L1-JACOBI");
|
||||
amg_c_dprecsetc(ph, "AGGR_FILTER", "FILTER");
|
||||
if ((ret = amg_c_dhierarchy_build(ah, cdh, ph)) != 0){
|
||||
fprintf(stderr, "From hierarchy_build: %d\n", ret);
|
||||
}{
|
||||
#if 0
|
||||
if (iam == 0) {
|
||||
fprintf(stdout, "Hierarchy built\n");
|
||||
}
|
||||
#endif
|
||||
}
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
if ((ret = amg_c_dsmoothers_build_opt(ah, cdh, ph, afmt, cdfmt)) != 0)
|
||||
fprintf(stderr, "From smoothers_build_format: %d\n", ret);
|
||||
#else
|
||||
if ((ret = amg_c_dsmoothers_build(ah, cdh, ph)) != 0)
|
||||
fprintf(stderr, "From smoothers_build: %d\n", ret);
|
||||
#endif
|
||||
#if 0
|
||||
if ( ret == 0){
|
||||
if (iam == 0) {
|
||||
fprintf(stdout, "Smoothers built\n");
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef PSB_HAVE_CUDA
|
||||
/* Allocate work vectors for the preconditioner on the GPU */
|
||||
info = amg_c_dallocate_wrk(ph, cdfmt);
|
||||
if (info != 0)
|
||||
{
|
||||
fprintf(stderr, "From dallocate_wrk: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
} else {
|
||||
if (iam == 0) {
|
||||
fprintf(stdout, "Preconditioner work vectors allocated\n");
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
psb_c_barrier(*cctxt);
|
||||
/* Do a dry run of the preconditioner */
|
||||
info = amg_c_dprecapply(ph, bh, xh, cdh);
|
||||
if (info != 0)
|
||||
{
|
||||
fprintf(stderr, "From dprec_apply: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
/* Do a dry run of the preconditioner with the option routine */
|
||||
info = amg_c_dprecapply_opt(ph, bh, xh, cdh, "N");
|
||||
if (info != 0)
|
||||
{
|
||||
fprintf(stderr, "From dprec_apply_opt: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
/*
|
||||
info = amg_c_dprecapply_opt(ph,bh,xh,cdh,"T");
|
||||
if (info != 0) {
|
||||
fprintf(stderr,"From dprec_apply_opt: %d\nBailing out\n",info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
*/
|
||||
/* Print the information on the preconditioner */
|
||||
if (iam == 0)
|
||||
{
|
||||
info = amg_c_ddescr(ph);
|
||||
if (info != 0)
|
||||
{
|
||||
fprintf(stderr, "From ddescr: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
}
|
||||
|
||||
/* Set up the solver options */
|
||||
psb_c_DefaultSolverOptions(&options);
|
||||
options.eps = 1.e-6;
|
||||
options.itmax = itmax;
|
||||
options.irst = irst;
|
||||
options.itrace = 1;
|
||||
options.istop = istop;
|
||||
psb_c_seterraction_ret();
|
||||
t1 = psb_c_wtime();
|
||||
ret = amg_c_dkrylov(methd, ah, ph, bh, xh, cdh, &options);
|
||||
t2 = psb_c_wtime();
|
||||
iter = options.iter;
|
||||
err = options.err;
|
||||
// fprintf(stderr,"From krylov: %d %lf, %d %d\n",iter,err,ret,psb_c_get_errstatus());
|
||||
if (psb_c_get_errstatus() != 0)
|
||||
{
|
||||
psb_c_print_errmsg();
|
||||
}
|
||||
// fprintf(stderr,"After cleanup %d\n",psb_c_get_errstatus());
|
||||
/* Check 2-norm of residual on exit */
|
||||
psb_c_dgeaxpby(one, bh, zero, rh, cdh);
|
||||
psb_c_dspmm(-one, ah, xh, one, rh, cdh);
|
||||
res2 = psb_c_dgenrm2(rh, cdh);
|
||||
|
||||
if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Time: %lf\n", (t2 - t1));
|
||||
fprintf(stdout, "Iter: %d\n", iter);
|
||||
fprintf(stdout, "Err: %lg\n", err);
|
||||
fprintf(stdout, "||r||_2: %lg\n", res2);
|
||||
}
|
||||
|
||||
#if DUMPATRIX
|
||||
psb_c_dmat_name_print(ah, "cbindmat.mtx");
|
||||
nlr = psb_c_cd_get_local_rows(cdh);
|
||||
bv = psb_c_dvect_get_cpy(bh);
|
||||
vectfile = fopen("cbindb.mtx", "w");
|
||||
for (i = 0; i < nlr; i++)
|
||||
fprintf(vectfile, "%lf\n", bv[i]);
|
||||
fclose(vectfile);
|
||||
|
||||
xv = psb_c_dvect_get_cpy(xh);
|
||||
nlr = psb_c_cd_get_local_rows(cdh);
|
||||
for (i = 0; i < nlr; i++)
|
||||
fprintf(stdout, "SOL: %d %d %lf\n", iam, i, xv[i]);
|
||||
|
||||
rv = psb_c_dvect_get_cpy(rh);
|
||||
nlr = psb_c_cd_get_local_rows(cdh);
|
||||
for (i = 0; i < nlr; i++)
|
||||
fprintf(stdout, "RES: %d %d %lf\n", iam, i, rv[i]);
|
||||
|
||||
#endif
|
||||
|
||||
/* Clean up memory */
|
||||
if ((info = psb_c_dgefree(xh, cdh)) != 0)
|
||||
{
|
||||
fprintf(stderr, "From dgefree: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
#if 0
|
||||
fprintf(stderr, "after dgefree xh\n");
|
||||
#endif
|
||||
if ((info = psb_c_dgefree(bh, cdh)) != 0)
|
||||
{
|
||||
fprintf(stderr, "From dgefree: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
#if 0
|
||||
fprintf(stderr, "after dgefree bh\n");
|
||||
#endif
|
||||
if ((info = psb_c_dgefree(rh, cdh)) != 0)
|
||||
{
|
||||
fprintf(stderr, "From dgefree: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
#if 0
|
||||
fprintf(stderr, "after dgefree rh\n");
|
||||
#endif
|
||||
if ((info = psb_c_cdfree(cdh)) != 0)
|
||||
{
|
||||
fprintf(stderr, "From cdfree: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
#if 0
|
||||
fprintf(stderr, "after cdfree\n");
|
||||
#endif
|
||||
// fprintf(stderr,"pointer from cdfree: %p\n",cdh->descriptor);
|
||||
|
||||
/* Clean up object handles */
|
||||
free(ph);
|
||||
free(xh);
|
||||
free(bh);
|
||||
free(ah);
|
||||
free(cdh);
|
||||
|
||||
if (iam == 0)
|
||||
fprintf(stderr, "program completed successfully\n");
|
||||
|
||||
#ifdef PSB_HAVE_CUDA
|
||||
psb_c_cuda_exit();
|
||||
#endif
|
||||
psb_c_barrier(*cctxt);
|
||||
psb_c_exit(*cctxt);
|
||||
free(cctxt);
|
||||
}
|
||||
@@ -0,0 +1,10 @@
|
||||
9 Number of entries below this
|
||||
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
|
||||
ML Preconditioner NONE DIAG BJAC
|
||||
HLG A Storage format CSR COO JAD (HOST) CSRG HLG (GPU)
|
||||
DEVICE Communication format CSR COO JAD (HOST) CSRG HLG (GPU)
|
||||
60 Domain size (acutal system is this**3)
|
||||
1 Stopping criterion
|
||||
80 MAXIT
|
||||
01 ITRACE
|
||||
20 IRST restart for RGMRES and BiCGSTABL
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user