Compare commits

..
80 Commits
Author SHA1 Message Date
sfilippone e627667f3c README updates 2025-12-23 11:50:39 +01:00
sfilippone 1557bcc45b Docs update 2025-12-23 11:37:01 +01:00
sfilippone 786abaff97 Bump minimum PSBLAS requirement to 3.9.0 2025-12-23 11:22:04 +01:00
sfilippone 06f8f83114 Update documentation for release 2025-12-23 11:21:53 +01:00
sfilippone 43a75e3171 Delete configure_n 2025-12-23 11:21:12 +01:00
Salvatore Filippone 2bde1beda2 README updates 2025-12-22 10:50:22 +01:00
Luca Pepè Sciarria 7d110a88d0 Update README.md with CMake building instuction 2025-12-22 10:42:43 +01:00
Salvatore Filippone f915372c99 Bump minimum prereq PSBLAS to 3.9.0. Document. 2025-12-20 21:02:32 +01:00
sfilippone b5df1842e0 Update handling of AMG_SLU_VERSION in configure and interface 2025-12-19 14:03:33 +01:00
sfilippone a6267d8e67 Update configure and interfaces for SUPERLU version 7. 2025-12-19 12:49:45 +01:00
Salvatore Filippone 498f8bd482 README updates 2025-12-17 18:24:55 +01:00
Salvatore Filippone 7aef98fc09 Improved error messaging for sample programs. Fix PDE2D 2025-12-17 14:14:19 +01:00
sfilippone 31a44360a4 Update for PSBLAS_CBIND switching to LINSOLVE 2025-12-09 10:25:02 +01:00
Salvatore Filippone 83a668c1e0 Improve Makefile dependencies 2025-11-22 12:05:20 +01:00
sfilippone c162633845 Merge branch 'cmake' into development 2025-11-21 11:42:51 +01:00
sfilippone 547c4f3a60 Fix template typo in KRM_SOLVER_IMPL 2025-11-20 14:59:15 +01:00
sfilippone 92766e743a Improved messaging from configure 2025-11-19 14:36:42 +01:00
sfilippone 212892e84a Silly bug in zprec cbind 2025-11-17 17:37:30 +01:00
Salvatore Filippone f9c0eec453 Fix overshooting tables. 2025-11-15 19:15:15 +01:00
sfilippone 387d6bef74 Fixes for compilation with IPK=8 2025-11-11 10:00:58 +01:00
sfilippone d6550abc70 Fix use psb_linsolve in the manual 2025-11-04 16:08:26 +01:00
Salvatore Filippone d95341b45a Typo in README.md 2025-10-20 09:30:22 +02:00
fdurastante 7da64944b5 Exposed prec%apply on the C interfaces 2025-10-14 18:04:12 +02:00
sfilippone daaa06e486 Fix USE statement 2025-09-23 16:16:08 +02:00
sfilippone 5ee819592f Fixes for compilation with INTEL 2025-09-23 13:12:10 +02:00
Luca Pepè Sciarria 5408e16a4a hot fix: add -ffree-line-length-256 compilation flag for fortran 2025-06-16 16:46:07 +02:00
Luca Pepè Sciarria 372ef708e0 hot fix: now it build cbind with the right source files 2025-06-16 11:41:39 +02:00
Luca Pepè Sciarria f4e1ba97e9 add mpi compilation 2025-06-13 13:15:43 +02:00
Luca Pepè Sciarria e429b04600 work on cpp part of amgprec. Still not working 2025-06-13 13:15:00 +02:00
Luca Pepè Sciarria 6c12de02e8 add cxx mpi version 2025-06-10 09:50:56 +02:00
Luca Pepè Sciarria 0cb2c1c0c6 hot fix 2025-06-10 08:37:17 +02:00
Luca Pepè Sciarria 7c153de54a add cpp file compilation; fix mpi compilation 2025-06-09 17:18:37 +02:00
Luca Pepè Sciarria 00cf38906a Merge branch 'cmake' of github.com:sfilippone/amg4psblas into cmake 2025-06-09 14:11:10 +02:00
Luca Pepè Sciarria 23cf86a797 hot fix: change filename extensions to F90 2025-06-09 14:10:45 +02:00
sfilippone 91bea72cfe Merge branch 'development' into cmake 2025-06-09 10:53:16 +02:00
Luca Pepè Sciarria 9a36a321f2 fix cmake 2025-06-09 10:13:05 +02:00
Luca Pepè Sciarria 60d722ec53 fix cmake 2025-06-09 10:09:28 +02:00
Luca Pepè Sciarria 1b8aa1618e fix cmake 2025-06-09 10:06:50 +02:00
Luca Pepè Sciarria 154e88cd69 hot fix 2025-06-09 09:46:59 +02:00
Luca Pepè Sciarria cf93042e42 now the cmake building works and compiles 2025-06-09 09:42:08 +02:00
Luca Pepè Sciarria ecaea5b794 hot fix: correct name for amg4psblas libraries 2025-06-09 09:39:21 +02:00
Luca Pepè Sciarria 3a42a2597c fix CMake building and compilation 2025-06-06 16:38:50 +02:00
Luca Pepè Sciarria fcf48ee614 hot fix: Config.cmake files now is properly installed 2025-06-06 16:11:59 +02:00
Salvatore Filippone 0ddd35b7b6 Users guide update 2025-06-06 11:12:52 +02:00
Luca Pepè Sciarria 4c19edb2f9 add CMakeLists.txt for samples subprojects 2025-06-06 10:15:55 +02:00
Luca Pepè Sciarria c7c02bf7c0 hot fix, change installation folder name from test to samples 2025-06-06 10:14:38 +02:00
sfilippone 7050095ca5 Users guide updates 2025-06-05 19:02:42 +02:00
Luca Pepè Sciarria b7edff0848 Merge branch 'development' into cmake 2025-06-05 16:31:58 +02:00
Luca Pepè Sciarria 6214a918f1 add installation of test under samples 2025-06-05 16:24:43 +02:00
sfilippone b724a324c9 Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2025-06-05 09:41:07 +02:00
sfilippone 21b85bc533 Update contributor list 2025-06-05 09:39:50 +02:00
sfilippone 3176a53a61 Merge branch 'development' into cmake 2025-06-03 09:33:15 +02:00
sfilippone b246223597 Fixes for IPK8 2025-06-01 20:57:09 +02:00
sfilippone 2f4c9dd579 Improve diagnostic printout in samples 2025-05-26 12:00:49 +02:00
Luca Pepè Sciarria 657986c938 Merge branch 'cmake' of github.com:sfilippone/amg4psblas into cmake 2025-04-17 14:35:48 +02:00
Luca Pepè Sciarria 687e0824e8 change how PSBLAS_INSTALL_DIR is set 2025-04-17 14:35:36 +02:00
Luca Pepè Sciarria 7abeb7d192 hot fix 2025-04-17 13:56:34 +02:00
Luca Pepè Sciarria 196cedfedb correct PSB_IPK/LPK flags, now set only for fortran compiler 2025-04-17 13:51:02 +02:00
Luca Pepè Sciarria 120da08860 remove fortran name mangling 2025-04-17 13:50:13 +02:00
Luca Pepè Sciarria 70b28ddc08 change install directory 2025-04-17 13:49:34 +02:00
sfilippone 22b37fa6d3 Fix REPL with MATCHBOXP 2025-04-16 15:02:52 +02:00
sfilippone 8fdff8e33b Merge branch 'cmake' of github.com:sfilippone/amg4psblas into cmake 2025-04-11 11:36:03 +02:00
Luca Pepè Sciarria 0d07a81aa7 add PSB_IPK and PSB_LPK compilation flags 2025-04-11 11:35:10 +02:00
sfilippone 64d2ead7a0 Merge branch 'cmake' of github.com:sfilippone/amg4psblas into cmake 2025-04-11 09:57:04 +02:00
Luca Pepè Sciarria e762554627 update to reflect the changes in development regarding amg_config.h file 2025-04-11 09:55:13 +02:00
Luca Pepè Sciarria b5e7d6aaaa Merge branch 'development' into cmake 2025-04-11 09:21:51 +02:00
sfilippone 886e03ab65 Merge branch 'development' into cmake 2025-04-10 17:43:45 +02:00
Luca Pepè Sciarria a0fc174c84 add import of psblas installation paths 2025-04-10 14:42:43 +02:00
sfilippone bbf5cc9826 Improve samples output formatting 2025-03-28 15:01:58 +01:00
Salvatore Filippone 8337edb362 Switch off detailed timings 2025-03-27 17:16:22 +01:00
sfilippone a39cd229e0 Improved dependencies in main makefile 2025-03-27 12:40:36 +01:00
sfilippone a983f95fc2 Add error handling after CDALL in samples 2025-03-27 12:40:31 +01:00
Luca Pepè Sciarria 5748358fe9 add make install configuration 2025-03-17 12:23:09 +01:00
Luca Pepè Sciarria 20b3c30e24 add output directory for .a libraries 2025-03-03 15:10:29 +01:00
Luca Pepè Sciarria d61c9fed9f init cmake build system 2025-02-24 16:20:50 +01:00
Luca Pepè Sciarria a8cf53d80e Add cbind build and compilation through cmake 2025-02-24 16:19:26 +01:00
Luca Pepè Sciarria 2efe639a19 add compilation flag for IPK4 LPK8 and build of amgprec library 2025-02-24 14:05:35 +01:00
Luca Pepè Sciarria b426a9ccf7 remove impl/solver/amg_*_invk_solver_set* from compiling 2025-02-24 14:04:54 +01:00
Luca Pepè Sciarria 1feaf40972 remove impl/solver/amg_*_invt_solver_set* from compiling 2025-02-24 13:45:27 +01:00
Luca Pepè Sciarria cc66413be8 remove impl/solver/amg_*_ainv_solver_set* from compiling 2025-02-24 13:41:45 +01:00
156 changed files with 8989 additions and 17275 deletions
+542
View File
@@ -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};")
+8 -7
View File
@@ -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) &&\
+105 -15
View File
@@ -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
+907
View File
@@ -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()
+7 -9
View File
@@ -58,23 +58,21 @@ MODOBJS=amg_base_prec_type.o amg_prec_type.o amg_prec_mod.o \
$(SMODOBJS) $(DMODOBJS) $(CMODOBJS) $(ZMODOBJS)
OBJS=$(MODOBJS)
LOCAL_MODS=$(MODOBJS:.o=$(.mod))
LIBNAME=libamg_prec.a
all: 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: mods impld
cd impl && $(MAKE) lib
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
$(AR) $(HERE)/$(LIBNAME) $(MODOBJS)
$(RANLIB) $(HERE)/$(LIBNAME)
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
@@ -221,7 +219,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
+8 -4
View File
@@ -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
View File
@@ -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)
+6 -5
View File
@@ -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
View File
@@ -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
View File
@@ -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)
+6 -5
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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)
+1 -1
View File
@@ -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'
+1 -1
View File
@@ -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'
+1 -1
View File
@@ -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')
+1 -1
View File
@@ -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')
+1 -2
View File
@@ -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
+10 -2
View File
@@ -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
+1 -2
View File
@@ -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
+2 -2
View File
@@ -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
+1 -2
View File
@@ -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
+2 -2
View File
@@ -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
+1 -2
View File
@@ -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
+2 -2
View File
@@ -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
@@ -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
@@ -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
@@ -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
!
@@ -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
@@ -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
!
@@ -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
+6
View File
@@ -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)
+1 -1
View File
@@ -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)
+10 -7
View File
@@ -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)
+1 -1
View File
@@ -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)
+10 -7
View File
@@ -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)
+1 -1
View File
@@ -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)
+10 -7
View File
@@ -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)
+1 -1
View File
@@ -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)
+10 -7
View File
@@ -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
+30
View File
@@ -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()
+1 -1
View File
@@ -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);
+3 -1
View File
@@ -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,6 +26,8 @@ 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_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);
+1 -1
View File
@@ -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);
+6 -4
View File
@@ -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 */
@@ -23,9 +23,11 @@ extern "C" {
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_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);
+155 -68
View File
@@ -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 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
@@ -77,24 +72,22 @@ contains
call 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
@@ -107,22 +100,20 @@ contains
call 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
@@ -136,25 +127,23 @@ contains
call stringc2f(what,fwhat)
call 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,9 +237,9 @@ 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
@@ -266,7 +251,7 @@ contains
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
@@ -302,7 +287,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
@@ -342,23 +327,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 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 +459,37 @@ 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
end module amg_dprec_cbind_mod
+141 -58
View File
@@ -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 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
@@ -77,24 +73,22 @@ contains
call 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
@@ -107,22 +101,20 @@ contains
call 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
@@ -136,21 +128,19 @@ contains
call stringc2f(what,fwhat)
call 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,9 +238,9 @@ 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
@@ -262,11 +248,9 @@ contains
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,11 +267,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
@@ -302,7 +283,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
@@ -342,23 +323,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 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 +455,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,11 +479,11 @@ 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
+1 -1
View File
@@ -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
#
+19
View File
@@ -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;
+7
View File
@@ -0,0 +1,7 @@
function(CapitalizeString string output_variable)
string(TOUPPER "${string}" _upper_string)
string(TOLOWER "${string}" _lower_string)
string(SUBSTRING "${_upper_string}" 0 1 _start)
string(SUBSTRING "${_lower_string}" 1 -1 _end)
set(${output_variable} "${_start}${_end}" PARENT_SCOPE)
endfunction()
+21
View File
@@ -0,0 +1,21 @@
#--------------------------
# Prohibit in-source builds
#--------------------------
if ("${CMAKE_CURRENT_SOURCE_DIR}" STREQUAL "${CMAKE_CURRENT_BINARY_DIR}")
message(FATAL_ERROR "ERROR! "
"CMAKE_CURRENT_SOURCE_DIR=${CMAKE_CURRENT_SOURCE_DIR}"
" == CMAKE_CURRENT_BINARY_DIR=${CMAKE_CURRENT_BINARY_DIR}"
"\nThis archive does not support in-source builds:\n"
"You must now delete the CMakeCache.txt file and the CMakeFiles/ directory under "
"the 'src' source directory or you will not be able to configure correctly!"
"\nYou must now run something like:\n"
" $ rm -r CMakeCache.txt CMakeFiles/"
"\n"
"Please create a directory outside the ${CMAKE_PROJECT_NAME} source tree and build under that outside directory "
"in a manner such as\n"
" $ mkdir build\n"
" $ cd build\n"
" $ CC=gcc FC=gfortran cmake -DBUILD_TYPE=Release -DCMAKE_INSTALL_PREFIX=/path/to/install/dir /path/to/psblas3/src/dir \n"
"\nsubstituting the appropriate syntax for your shell (the above line assumes the bash shell)."
)
endif()
+95
View File
@@ -0,0 +1,95 @@
if (METIS_INCLUDES AND METIS_LIBRARIES)
set(METIS_FIND_QUIETLY TRUE)
endif (METIS_INCLUDES AND METIS_LIBRARIES)
if( DEFINED ENV{METISDIR} )
if( NOT DEFINED METIS_ROOT )
set(METIS_ROOT "$ENV{METISDIR}")
endif()
endif()
if( (DEFINED ENV{METIS_ROOT}) OR (DEFINED METIS_ROOT) )
if( NOT DEFINED METIS_ROOT)
set(METIS_ROOT "$ENV{METIS_ROOT}")
endif()
set(METIS_HINTS "${METIS_ROOT}")
endif()
find_path(METIS_INCLUDES
NAMES
metis.h
HINTS
${METIS_HINTS}
PATHS
"${INCLUDE_INSTALL_DIR}"
/usr/local/opt
/usr/local
PATH_SUFFIXES
include
)
if(METIS_INCLUDES)
foreach(include IN_LISTS METIS_INCLUDES)
get_filename_component(mts_include_dir "${include}" DIRECTORY)
get_filename_component(mts_abs_include_dir "${mts_include_dir}" ABSOLUTE)
get_filename_component(new_mts_hint "${include_dir}/.." ABSOLUTE )
list(APPEND METIS_HINTS "${new_mts_hint}")
break()
endforeach()
endif()
if(METIS_HINTS)
list(REMOVE_DUPLICATES METIS_HINTS)
endif()
macro(_metis_check_version)
file(READ "${METIS_INCLUDES}/metis.h" _metis_version_header)
string(REGEX MATCH "define[ \t]+METIS_VER_MAJOR[ \t]+([0-9]+)" _metis_major_version_match "${_metis_version_header}")
set(METIS_MAJOR_VERSION "${CMAKE_MATCH_1}")
string(REGEX MATCH "define[ \t]+METIS_VER_MINOR[ \t]+([0-9]+)" _metis_minor_version_match "${_metis_version_header}")
set(METIS_MINOR_VERSION "${CMAKE_MATCH_1}")
string(REGEX MATCH "define[ \t]+METIS_VER_SUBMINOR[ \t]+([0-9]+)" _metis_subminor_version_match "${_metis_version_header}")
set(METIS_SUBMINOR_VERSION "${CMAKE_MATCH_1}")
if(NOT METIS_MAJOR_VERSION)
message(STATUS "Could not determine Metis version. Assuming version 4.0.0")
set(METIS_VERSION 4.0.0)
else()
set(METIS_VERSION ${METIS_MAJOR_VERSION}.${METIS_MINOR_VERSION}.${METIS_SUBMINOR_VERSION})
endif()
if(${METIS_VERSION} VERSION_LESS ${Metis_FIND_VERSION})
set(METIS_VERSION_OK FALSE)
else()
set(METIS_VERSION_OK TRUE)
endif()
if(NOT METIS_VERSION_OK)
message(STATUS "Metis version ${METIS_VERSION} found in ${METIS_INCLUDES}, "
"but at least version ${Metis_FIND_VERSION} is required")
endif(NOT METIS_VERSION_OK)
endmacro(_metis_check_version)
if(METIS_INCLUDES AND Metis_FIND_VERSION)
_metis_check_version()
else()
set(METIS_VERSION_OK TRUE)
endif()
find_library(METIS_LIBRARIES metis
HINTS
${METIS_HINTS}
PATHS
"${LIB_INSTALL_DIR}"
/usr/local/
/usr/local/opt
PATH_SUFFIXES
lib
lib64
metis/lib)
include(FindPackageHandleStandardArgs)
find_package_handle_standard_args(METIS DEFAULT_MSG
METIS_INCLUDES METIS_LIBRARIES METIS_VERSION_OK)
mark_as_advanced(METIS_INCLUDES METIS_LIBRARIES)
+12
View File
@@ -0,0 +1,12 @@
Mac users can use GPGTools - https://gpgtools.org
Comment: Download Izaak Beekman's GPG public key from your
Comment: trusted key server or from
Comment: https://izaakbeekman.com/izaak.pubkey.txt
Comment: Next add it to your GPG keyring, e.g.,
Comment: `curl https://izaakbeekman.com/izaak.pubkey.txt | gpg --import`
Comment: Make sure you have verified that the release archive's
Comment: SHA256 checksum matches the provided
Comment: psblas-@git_version@-SHA256.txt and ensure that this file
Comment: and it's signature are in the same directory. Then
Comment: verify with:
Comment: `gpg --verify psblas-@git_version@-SHA256.txt.asc`
+3
View File
@@ -0,0 +1,3 @@
# To verify cryptographic checksums `shasum -c psblas-@git_version@-SHA256.txt` on Mac OS X, or
# `sha256sum -c psblas-@git_version@-SHA256.txt` on Linux.
@sha256_checksum@
+11
View File
@@ -0,0 +1,11 @@
# Config file for the installed package
set(amg4psblas_VERSION "@amg4psblas_VERSION@")
# Include directories
set(amg4psblas_INCLUDE_DIRS "@CMAKE_INSTALL_INCLUDEDIR@")
include(CMakeFindDependencyMacro)
# Provide the targets
include("${CMAKE_CURRENT_LIST_DIR}/@CMAKE_PROJECT_NAME@Targets.cmake")
+79
View File
@@ -0,0 +1,79 @@
# CMake file to be called in script mode (${CMAKE_COMMAND} -P <file>) to
# Generate a source archive release asset from add_custom_command
#
# See SourceDistTarget.cmake
if(NOT CMAKE_ARGV3)
message(FATAL_ERROR "Must pass the top level src dir to ${CMAKE_ARGV2} as the first argument")
endif()
if(NOT CMAKE_ARGV4)
message(FATAL_ERROR "Must pass the top level src dir to ${CMAKE_ARGV2} as the second argument")
endif()
find_package(Git)
if(NOT GIT_FOUND)
message( FATAL_ERROR "You can't create a source archive release asset without git!")
endif()
execute_process(COMMAND "${GIT_EXECUTABLE}" describe --always
RESULT_VARIABLE git_status
OUTPUT_VARIABLE git_version
WORKING_DIRECTORY "${CMAKE_ARGV3}"
OUTPUT_STRIP_TRAILING_WHITESPACE)
if(NOT (git_status STREQUAL "0"))
message( FATAL_ERROR "git describe --always failed with exit status: ${git_status} and message:
${git_version}")
endif()
set(archive "AMG4PSBLAS-${git_version}")
set(l_archive "AMG4PSBLAS-${git_version}")
set(release_asset "${CMAKE_ARGV4}/${archive}.tar.gz")
execute_process(
COMMAND "${GIT_EXECUTABLE}" archive "--prefix=${archive}/" -o "${release_asset}" "${git_version}"
RESULT_VARIABLE git_status
OUTPUT_VARIABLE git_output
WORKING_DIRECTORY "${CMAKE_ARGV3}"
OUTPUT_STRIP_TRAILING_WHITESPACE)
if(NOT (git_status STREQUAL "0"))
message( FATAL_ERROR "git archive ... failed with exit status: ${git_status} and message:
${git_output}")
else()
message( STATUS "Source code release asset created from `git archive`: ${release_asset}")
endif()
file(SHA256 "${release_asset}" tarball_sha256)
set(sha256_checksum "${tarball_sha256} ${archive}.tar.gz")
configure_file("${CMAKE_ARGV3}/cmake/AMG4PSBLAS-VER-SHA256.txt.in"
"${CMAKE_ARGV4}/${l_archive}-SHA256.txt"
@ONLY)
message( STATUS
"SHA 256 checksum of release tarball written out as: ${CMAKE_ARGV4}/${l_archive}-SHA256.txt" )
find_program(GPG_EXECUTABLE
gpg
DOC "Location of GnuPG (gpg) executable")
if(GPG_EXECUTABLE)
execute_process(
COMMAND "${GPG_EXECUTABLE}" --armor --detach-sign --comment "@gpg_comment@" "${CMAKE_ARGV4}/${l_archive}-SHA256.txt"
RESULT_VARIABLE gpg_status
OUTPUT_VARIABLE gpg_output
WORKING_DIRECTORY "${CMAKE_ARGV4}")
if(NOT (gpg_status STREQUAL "0"))
message( WARNING "GPG signing of ${CMAKE_ARGV4}/${l_archive}-SHA256.txt appears to have failed
with status: ${gpg_status} and output: ${gpg_output}")
else()
configure_file("${CMAKE_ARGV3}/cmake/AMG4PSBLAS-VER-SHA256.txt.asc.in"
"${CMAKE_ARGV4}/${l_archive}-GPG.comment"
@ONLY)
file(READ "${CMAKE_ARGV4}/${l_archive}-GPG.comment" gpg_comment)
configure_file("${CMAKE_ARGV4}/${l_archive}-SHA256.txt.asc"
"${CMAKE_ARGV4}/${l_archive}-SHA256.txt.asc.out"
@ONLY)
file(RENAME "${CMAKE_ARGV4}/${l_archive}-SHA256.txt.asc.out"
"${CMAKE_ARGV4}/${l_archive}-SHA256.txt.asc")
message(STATUS "GPG signed SHA256 checksum created: ${CMAKE_ARGV4}/${l_archive}-SHA256.txt.asc")
endif()
endif()
+16
View File
@@ -0,0 +1,16 @@
# Config file for the INSTALLED package
# Allow other CMake projects to find this package if it is installed
# Requires the use of the standard CMake module CMakePackageConfigHelpers
set ( @CMAKE_PROJECT_NAME@_VERSION @VERSION@ )
###@COMPILER_CONSISTENCY_CHECK@
@PACKAGE_INIT@
# Provide the targets
set_and_check ( @PACKAGE_NAME@_CONFIG_INSTALL_DIR "@PACKAGE_EXPORT_INSTALL_DIR@" )
include ( "${@PACKAGE_NAME@_CONFIG_INSTALL_DIR}/@PACKAGE_NAME@-targets.cmake" )
# Make the module files available via include
set_and_check ( @CMAKE_PROJECT_NAME@_INCLUDE_DIRS "@PACKAGE_INSTALL_MOD_DIR@" )
+90
View File
@@ -0,0 +1,90 @@
include(CMakeParseArguments)
# Function to parse version info from git and/or .VERSION file
function(set_version)
set(options "")
set(oneValueArgs VERSION_VARIABLE GIT_DESCRIBE_VAR CUSTOM_VERSION_FILE CUSTOM_VERSION_REGEX )
set(multiValueArgs "")
cmake_parse_arguments(set_version "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN})
# Algorithm:
# 1. Get first line of .VERSION file, which will be set via `git archive` so long as
#
# 2. If not a packaged release check if this is an active git repo
# 3. Get version info from `git describe`
# 4. First the most recent tag is fetched if available
# 5. Then the full `git describe` output is fetched
if(NOT set_version_CUSTOM_VERSION_REGEX)
set(_VERSION_REGEX "[vV]*[0-9]+\\.[0-9]+\\.[0-9]+")
else()
set(_VERSION_REGEX ${set_version_CUSTOM_VERSION_REGEX})
endif()
if(NOT set_version_CUSTOM_VERSION_FILE)
set(_VERSION_FILE "${CMAKE_SOURCE_DIR}/.VERSION")
else()
set(_VERSION_FILE "${set_version_CUSTOM_VERSION_FILE}")
endif()
file(STRINGS "${_VERSION_FILE}" first_line
LIMIT_COUNT 1
)
string(REGEX MATCH ${_VERSION_REGEX}
_package_version "${first_line}")
if((NOT (_package_version MATCHES ${_VERSION_REGEX})) AND (EXISTS "${CMAKE_SOURCE_DIR}/.git"))
message( STATUS "Build from git repository detected")
find_package(Git)
if(GIT_FOUND)
set(GIT_FOUND "${GIT_FOUND}" PARENT_SCOPE)
execute_process(COMMAND "${GIT_EXECUTABLE}" describe --abbrev=0
WORKING_DIRECTORY "${CMAKE_SOURCE_DIR}"
RESULT_VARIABLE _git_status
OUTPUT_VARIABLE _git_output
OUTPUT_STRIP_TRAILING_WHITESPACE)
if((_git_status STREQUAL "0") AND (_git_output MATCHES ${_VERSION_REGEX}))
set(_package_version "${_git_output}")
endif()
execute_process(COMMAND "${GIT_EXECUTABLE}" describe --always
WORKING_DIRECTORY "${CMAKE_SOURCE_DIR}"
RESULT_VARIABLE _git_status
OUTPUT_VARIABLE _full_git_describe
OUTPUT_STRIP_TRAILING_WHITESPACE)
if(NOT (_git_status STREQUAL "0"))
set(_full_git_describe NOTFOUND)
endif()
else()
message( WARNING "Could not find git executable!")
endif()
endif()
if(NOT (_package_version MATCHES ${_VERSION_REGEX}))
message( WARNING "Could not extract version from git, falling back on ${_VERSION_FILE}.")
file(STRINGS ".VERSION" _package_version
REGEX ${_VERSION_REGEX}
)
endif()
if(NOT _full_git_describe)
set(_full_git_describe ${_package_version})
endif()
# Strip leading "v" character from package version tags so that
# the version string can be passed to the CMake `project` command
string(REPLACE "v" "" _package_version "${_package_version}")
string(REPLACE "V" "" _package_version "${_package_version}")
if(set_version_VERSION_VARIABLE)
set(${set_version_VERSION_VARIABLE} ${_package_version} PARENT_SCOPE)
else()
set(PROJECT_VERSION ${_package_version} PARENT_SCOPE)
endif()
if(set_version_GIT_DESCRIBE_VAR)
set(${set_version_GIT_DESCRIBE_VAR} ${_full_git_describe} PARENT_SCOPE)
else()
set(FULL_GIT_DESCRIBE ${_full_git_describe} PARENT_SCOPE)
endif()
endfunction()
+23
View File
@@ -0,0 +1,23 @@
# Adapted from http://www.cmake.org/Wiki/CMake_FAQ#Can_I_do_.22make_uninstall.22_with_CMake.3F May 1, 2014
if(NOT EXISTS "@CMAKE_BINARY_DIR@/install_manifest.txt")
message(FATAL_ERROR "Cannot find install manifest: @CMAKE_BINARY_DIR@/install_manifest.txt")
endif(NOT EXISTS "@CMAKE_BINARY_DIR@/install_manifest.txt")
file(READ "@CMAKE_BINARY_DIR@/install_manifest.txt" files)
string(REGEX REPLACE "\n" ";" files "${files}")
foreach(file ${files})
message(STATUS "Uninstalling $ENV{DESTDIR}${file}")
if(IS_SYMLINK "$ENV{DESTDIR}${file}" OR EXISTS "$ENV{DESTDIR}${file}")
exec_program(
"@CMAKE_COMMAND@" ARGS "-E remove \"$ENV{DESTDIR}${file}\""
OUTPUT_VARIABLE rm_out
RETURN_VALUE rm_retval
)
if(NOT "${rm_retval}" STREQUAL 0)
message(FATAL_ERROR "Problem when removing $ENV{DESTDIR}${file}")
endif(NOT "${rm_retval}" STREQUAL 0)
else(IS_SYMLINK "$ENV{DESTDIR}${file}" OR EXISTS "$ENV{DESTDIR}${file}")
message(STATUS "File $ENV{DESTDIR}${file} does not exist.")
endif(IS_SYMLINK "$ENV{DESTDIR}${file}" OR EXISTS "$ENV{DESTDIR}${file}")
endforeach(file)
+25 -6
View File
@@ -749,21 +749,40 @@ if test "x$pac_slu_header_ok" == "xyes" ; then
AC_MSG_RESULT($pac_slu_lib_ok)
fi
if test "x$pac_slu_header_ok" == "xyes" ; then
AC_MSG_CHECKING([for superlu version 5])
AC_MSG_CHECKING([for superlu version 7])
AC_LANG_PUSH([C])
AC_COMPILE_IFELSE(
[AC_LANG_SOURCE([[#include "slu_ddefs.h"
int testdslu()
[AC_LANG_SOURCE([[#include "slu_cdefs.h"
int testcslu()
{ SuperMatrix AC, *L, *U;
int *perm_r, *perm_c, *etree, panel_size, permc_spec, relax, info;
superlu_options_t options; SuperLUStat_t stat;
singlecomplex *x;
GlobalLU_t Glu;
dgstrf(&options, &AC, relax, panel_size, etree,
cgstrf(&options, &AC, relax, panel_size, etree,
NULL, 0, perm_c, perm_r, L, U, &Glu, &stat, &info);
}]])],
[ AC_MSG_RESULT([yes]); pac_slu_version="5";],
[ AC_MSG_RESULT([no]); pac_slu_version="4";])
[ AC_MSG_RESULT([yes]); pac_slu_version="7";],
[ AC_MSG_RESULT([no]); pac_slu_version="";])
if test "x$pac_slu_version" == "x" ; then
AC_MSG_CHECKING([for superlu version 5])
AC_LANG_PUSH([C])
AC_COMPILE_IFELSE(
[AC_LANG_SOURCE([[#include "slu_ddefs.h"
int testdslu()
{ SuperMatrix AC, *L, *U;
int *perm_r, *perm_c, *etree, panel_size, permc_spec, relax, info;
superlu_options_t options; SuperLUStat_t stat;
GlobalLU_t Glu;
dgstrf(&options, &AC, relax, panel_size, etree,
NULL, 0, perm_c, perm_r, L, U, &Glu, &stat, &info);
}]])],
[ AC_MSG_RESULT([yes]); pac_slu_version="5";],
[ AC_MSG_RESULT([no]); pac_slu_version="4";])
AC_LANG_POP([C])
fi
AC_LANG_POP([C])
fi
Vendored
+1500 -944
View File
File diff suppressed because it is too large Load Diff

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